{;; This is the RUCI LISP compiler; It was originally copied from Stanford but has since been 
extensively modified; Entirely new code from UCI and Rutgers is at the end of the file;⎇

(DECLARE (SPECIAL *NOPOINT *NOPOINTDSK ACS ALLACS ALLFUNS ARRAYAC BASE CATCH CCLST CODESIZE
		  CONSTSIZE CTAG CURLOCVS DEBUGXPR EXIT EXITN FARGAC FOUNDFREE FUNNAME GENFUNS
		  GOLIST GOTABAC IBASE INDEV INLSUBR INPROG INUM0 LAPKLST LAPLST LASTOUT LDLST
		  LISTING LOCVARS MINDEPTH MSGCHAN NACS OBLIST OUTDEV OUTEXT P1CNT P1SCNT P2CNT PDL
		  PDLDEPTH PRGSPFLG PROGSW PROGVARS PRSSL PVR RENAMELIST RSL SELECTQ SHOWNAMES
		  SPECIALS SPECVARS SPLDLST THROW TRACELIST UNDFUNS VALUEAC VARLIST VGO)
	 (*FSUBR COMPERR USERERR))

{;; Compiler Macros:⎇

(DEFPROP FIRSTPROP (LAMBDA (L) (CONS 'CDR (CDR L))) MACRO)

(DEFPROP FLUSHDEF (LAMBDA (L) (CONS 'FLUSHEXPR (CDR L))) MACRO)

(DEFPROP GENTAG (LAMBDA (L) '(NEXTSYM 'TAG)) MACRO)

(DEFPROP GENVAL (LAMBDA (L) '(NEXTSYM 'VAL)) MACRO)

(DEFPROP GENVAR (LAMBDA (L) '(NEXTSYM 'VAR)) MACRO)

(DEFPROP GETPROP (LAMBDA (L) (CONS 'GET (CDR L))) MACRO)

(DEFPROP INCR
 (LAMBDA (L) (LIST 'SETQ (CADR L) (LIST 'ADD1 (CADR L))))
 MACRO)

(DEFPROP LASTPROP (LAMBDA (L) (CONS 'NULL (CDR L))) MACRO)

(DEFPROP NEXTPROP (LAMBDA (L) (CONS 'CDDR (CDR L))) MACRO)

(DEFPROP OUTINST (LAMBDA (INST) (CONS 'OUTSTAT (CDR INST))) MACRO)

(DEFPROP OUTPSOP (LAMBDA (PSOP) (CONS 'OUTSTAT (CDR PSOP))) MACRO)

(DEFPROP OUTTAG (LAMBDA (TAG) (CONS 'OUTSTAT (CDR TAG))) MACRO)

(DEFPROP PDLDEPTH (LAMBDA (L) 'PDLDEPTH) MACRO)

(DEFPROP PROPNAM (LAMBDA (L) (CONS 'CAR (CDR L))) MACRO)

(DEFPROP PROPVAL (LAMBDA (L) (CONS 'CADR (CDR L))) MACRO)

(DEFPROP SETPROP
 (LAMBDA (L) (LIST 'PUTPROP (CADR L) (CADDDR L) (CADDR L)))
 MACRO)

(DEFPROP TAGP (LAMBDA (L) (CONS 'ATOM (CDR L))) MACRO)

(DEFPROP USERWARN
 (LAMBDA (L)
  (LIST 'PRINTMSG
	(LIST 'APPEND
	      (LIST 'LIST (CADR L))
	      (LIST 'QUOTE (APPEND (CDDR L) '(IN)))
	      '(LIST (CURFUN)))))
 MACRO)

{;; Top Level:⎇

(DEFPROP ACTONEXPR
 (LAMBDA (XPR)
  (PROG (ACTION)
	(COND [(ATOM XPR) (GO FLUSH)])
	(SETQ ACTION (GETGET (CAR XPR) 'COMPEFFECT))
	(COND [ACTION ((PROPVAL ACTION) XPR) (RETURN NIL)])
  FLUSH (FLUSHEXPR XPR)
	(RETURN NIL)))
 EXPR)

(DEFPROP ACTONMACRO
 (LAMBDA (XPR) (ACTONEXPR ((GETPROP (CAR XPR) 'MACRO) XPR)))
 EXPR)

(DEFPROP CMP
 (LAMBDA (L)
  (COND [(NULL L) NIL]
	[(NULL (CDR L)) (COMPILEFUN (CAR L))]
	[T (APPLY# 'DE L) (COMPILEFUN (CAR L))]))
 FEXPR)

(DEFPROP COMPDEF
 (LAMBDA (DEFIN)
  (PROG (ACTION)
	(COND [(NOT (EQUAL (LENGTH DEFIN) 4Q)) (USERERR ARGNOERR-COMPDEF)])
	(COND [(SETQ ACTION (SEEKPROP (CADDDR DEFIN) 'DEFACTION))
	       ((PROPVAL ACTION) DEFIN)
	       (RETURN NIL)])
	(FLUSHDEF DEFIN)
	(RETURN NIL)))
 EXPR)

(DEFPROP COMPFILE
 (LAMBDA (INFILE OUTFILE)
  (PROG (ALLFUNS UNDFUNS GENFUNS CODESIZE CONSTSIZE STARTTIME *NOPOINT)
	(SETQ *NOPOINT *NOPOINTDSK)
	(SETQ STARTTIME (TIME))
	(SETQ CODESIZE (SETQ CONSTSIZE 0Q))
	(DOFILE (FUNCTION COMPREADS) INFILE OUTFILE)
	(TELLTALE (CADR INFILE) STARTTIME)))
 EXPR)

(DEFPROP COMPFUNC
 (LAMBDA (NAME EXPR FLAG)
  (PROG (LOCVARS SPECVARS P1EXP P1CNT P2CNT LASTOUT INLSUBR)
	(INITSYM 'TAG)
	(INITSYM 'VAL)
	(INITSYM 'VAR)
	(INITSYM 'SUBFUN)
	(INITPROP 'CURFUN 'NAME NAME)
	(SETQ P1EXP (PASS1 EXPR))
	(DEINITSYM 'SUBFUN)
	(TERPRI)
	(OUTPSOP (LIST 'LAP NAME FLAG))
	(COND [(EQ (CAR EXPR) 'FSUBR)
	       (COND [(NOT (NULL (CDADR EXPR))) (OUTINST '(PUSHJ P *AMAKE))])]
	      [(EQ (CAR EXPR) 'LSUBR) (OUTINST '(JSP 3Q *LCALL)) (SETQ INLSUBR T)])
	(PASS2 P1EXP)
	(TERPRI)
	(DELETEPROP 'CURFUN 'NAME)
	(COND [(NOT (EQUAL P2CNT P1CNT))
	       (PRINTMSG (LIST P1CNT P2CNT))
	       (COMPERR COUNTSDISAGREE-COMPFUNC)])
	(DEINITSYM 'TAG)
	(DEINITSYM 'VAL)
	(DEINITSYM 'VAR)
	(RETURN NAME)))
 EXPR)

(DEFPROP COMPILE
 (LAMBDA (NAMES)
  (PROG (DONE)
   LOOP (COND [(NULL NAMES) (OUTC NIL T) (RETURN DONE)])
	(COND [(NOT (ATOM (CAR NAMES))) (OUTC (EVAL (CONS 'OUTPUT (CAR NAMES))) NIL)]
	      [T (SETQ DONE (NCONC DONE (COMPILEFUN (CAR NAMES))))])
	(SETQ NAMES (CDR NAMES))
	(GO LOOP)))
 FEXPR)

(DEFPROP COMPILEFUN
 (LAMBDA (NAME)
  (PROG (GENFUNS UNDFUNS CODESIZE CONSTSIZE MSGCHAN SHOWNAMES PROP DONE PLIST)
	(UNBREAK! NAME)
	(SETQ CODESIZE (SETQ CONSTSIZE 0Q))
	(SETQ PLIST (CDR NAME))
   LOOP (COND [(NULL PLIST) (RETURN (REVERSE DONE))])
	(SETQ PROP (SEEKPROP (CAR PLIST) 'DEFACTION))
	(COND [(NULL PROP) (GO ELOOP)])
	(SETQ DONE (CONS (CONS NAME (CAR PLIST)) DONE))
	(UNMACEXPAND (CADR PLIST))
	((PROPVAL PROP) (LIST 'DEFPROP NAME (CADR PLIST) (CAR PLIST)))
  ELOOP (SETQ PLIST (CDDR PLIST))
	(GO LOOP)))
 EXPR)

(DEFPROP COMPL
 (LAMBDA (FILES)
  (PROG (MSGCHAN)
	(COND [(NOT (NULL LISTING)) (SETQ MSGCHAN (EVAL (MCONS 'OUTPUT (GENSYM) LISTING)))])
   LOOP (COND [(NULL FILES) (OUTC MSGCHAN NIL) (OUTC NIL T) (RETURN NIL)])
	(COND [(%DEVP (CAR FILES)) (SETQ INDEV (CAR FILES)) (GO ELOOP)])
	(COMPFILE (LIST INDEV (CAR FILES))
		  (LIST OUTDEV 
			(CONS (COND [(ATOM (CAR FILES)) (CAR FILES)] [T (CAAR FILES)]) OUTEXT)))
  ELOOP (SETQ FILES (CDR FILES))
	(GO LOOP)))
 FEXPR)

(DEFPROP COMPREADS (LAMBDA NIL (READLOOP (FUNCTION ACTONEXPR))) EXPR)

(DEFPROP CURFUN (LAMBDA NIL (GETPROP 'CURFUN 'NAME)) EXPR)

(DEFPROP DECLARE (LAMBDA (L) (MAPC (FUNCTION EVAL) L)) FEXPR)

(DEFPROP DEFEXPR
 (LAMBDA (DEF)
  (PROG (FN EX)
	(TYPEFN (SETQ FN (CADR DEF)))
	(SETQ EX (CADDR DEF))
	(COND [(OR [ATOM EX] [NOT (EQ (CAR EX) 'LAMBDA)]) (FLUSHDEF DEF)]
	      [(AND [ATOM (CADR EX)] [NOT (NULL (CADR EX))])
	       (COND [(REMPROP FN '*UNDEF) (PRINTMSG (CONS FN '(LSUBR USED AS SUBR)))])
	       (PUTPROP FN T '*LSUBR)
	       (FUNVARTST FN 'LSUBR)
	       (COMPFUNC FN (MCONS 'LSUBR (LIST (CADR EX)) (CDDR EX)) 'LSUBR)]
	      [T (REMPROP FN '*UNDEF)
		 (PUTPROP FN (LENGTH (CADR EX)) '*SUBR)
		 (FUNVARTST FN 'SUBR)
		 (COMPFUNC FN (CONS 'SUBR (CDR EX)) 'SUBR)])))
 EXPR)

(DEFPROP DEFFEXPR
 (LAMBDA (DEF)
  (PROG (FN EX)
	(TYPEFN (SETQ FN (CADR DEF)))
	(SETQ EX (CADDR DEF))
	(COND [(REMPROP FN '*UNDEF) (PRINTMSG (CONS FN '(FSUBR USED AS SUBR)))])
	(PUTPROP FN T '*FSUBR)
	(FUNVARTST FN 'FSUBR)
	(COMPFUNC FN (CONS 'FSUBR (CDR EX)) 'FSUBR)))
 EXPR)

(DEFPROP DEFMACRO
 (LAMBDA (DEF)
  (PROG (FN)
	(TYPEFN (SETQ FN (CADR DEF)))
	(COND [(REMPROP FN '*UNDEF) (PRINTMSG (CONS FN '(MACRO USED AS SUBR)))])
	(PUTPROP FN (CADDR DEF) 'MACRO)
	(COND [(GET FN 'GLOBALMACRO) (FLUSHDEF DEF)])
	(FUNVARTST FN 'MACRO)))
 EXPR)

(DEFPROP DO*EXPR
 (LAMBDA (DEF) (PUTPROP (CADR DEF) (CADDR DEF) '*SUBR))
 EXPR)

(DEFPROP DO*FEXPR
 (LAMBDA (DEF) (PUTPROP (CADR DEF) (CADDR DEF) '*FSUBR))
 EXPR)

(DEFPROP DO*LEXPR
 (LAMBDA (DEF) (PUTPROP (CADR DEF) (CADDR DEF) '*LSUBR))
 EXPR)

(DEFPROP DOACT (LAMBDA (XPR) ((GETPROP (CAR XPR) 'COMPACTION) XPR)) EXPR)

(DEFPROP DODE
 (LAMBDA (L)
  (DEFEXPR (MAKDEF (CADR L) (CADDR L) (CADDRLAM (CDR L)) 'EXPR)))
 EXPR)

(DEFPROP DODF
 (LAMBDA (L)
  (DEFFEXPR (MAKDEF (CADR L) (CADDR L) (CADDRLAM (CDR L)) 'FEXPR)))
 EXPR)

(DEFPROP DODM
 (LAMBDA (L)
  (DEFMACRO (MAKDEF (CADR L) (CADDR L) (CADDRLAM (CDR L)) 'MACRO)))
 EXPR)

(DEFPROP DOFILE
 (LAMBDA (DOREADS INFILE OUTFILE)
  (PROG NIL
	(EVAL (MCONS 'INPUT 'INCHAN INFILE))
	(EVAL (MCONS 'OUTPUT 'OUTCHAN OUTFILE))
	(INC 'INCHAN NIL)
	(OUTC 'OUTCHAN NIL)
	(DOREADS)
	(OUTC NIL T)
	(INC NIL T)))
 EXPR)

(DEFPROP FLUSHEXPR
 (LAMBDA (EXPR) (TERPRI) (SPRINT EXPR 1Q) (TERPRI))
 EXPR)

(DEFPROP FLUSHLAP
 (LAMBDA (ENTRY)
  (PROG (NAME FLAG TYPE STAT)
	(TYPEFN (SETQ NAME (CADR ENTRY)))
	(SETQ FLAG (CADDR ENTRY))
	(SETQ TYPE (ASSOC FLAG '((FSUBR *FSUBR) (LSUBR *LSUBR) (SUBR *SUBR))))
	(COND [(NULL TYPE) (GO PRINT)])
	(SETQ TYPE (CADR TYPE))
	(COND [(AND [MEMQ TYPE '(*FSUBR *LSUBR)] [GETPROP NAME '*UNDEF])
	       (PRINTMSG (MCONS NAME FLAG '(USED AS SUBR)))])
	(SETPROP NAME TYPE T)
	(REMPROP NAME '*UNDEF)
  PRINT (TERPRI)
	(OUTPUTSTAT ENTRY)
   LOOP (SETQ STAT (ERRSET (READ)))
	(COND [(ATOM STAT) (USERERR READERR-FLUSHLAP)])
	(OUTPUTSTAT (CAR STAT))
	(COND [(NULL (CAR STAT)) (TERPRI) (RETURN NIL)])
	(GO LOOP)))
 EXPR)

(DEFPROP FUNVARTST
 (LAMBDA (FN TYPE)
  (COND [(REMPROP FN '*FUNVAR) (PRINTMSG (MCONS FN TYPE '(USED AS VARIABLE)))]))
 EXPR)

(DEFPROP MAKDEF
 (LAMBDA (NAME ARGS BODY TYPE)
  (LIST 'DEFPROP NAME (LIST 'LAMBDA ARGS BODY) TYPE))
 EXPR)

(DEFPROP PRINTMSG
 (LAMBDA (MESSAGE)
  (PROG (CHAN)
	(SETQ CHAN (OUTC MSGCHAN NIL))
	(COND [(NOT (ATMARGIN)) (LINEF 2Q)])
	(MAPPRINS (CONS '* MESSAGE))
	(LINEF 1Q)
	(OUTC CHAN NIL)))
 EXPR)

(DEFPROP READLOOP
 (LAMBDA (ACTFUN)
  (PROG (EXPR)
   LOOP (SETQ EXPR (ERRSET (READ)))
	(COND [(EQ EXPR '$EOF$) (RETURN NIL)])
	(ACTFUN (CAR EXPR))
	(GO LOOP)))
 EXPR)

(DEFPROP SPECIAL (LAMBDA (X) (MAPCAR (FUNCTION MAKESPECIAL) X)) FEXPR)

(DEFPROP TELLTALE
 (LAMBDA (FILENAME STARTTIME)
  (PROG (CHAN UNDS)
	(SETQ CHAN (OUTC MSGCHAN NIL))
	(CARRETN)
	(LINEF 1Q)
	(MAPPRINS (LIST FILENAME 'COMPILED))
	(MAPPRINS (LIST CODESIZE 'WORDS))
	(MAPPRINS (LIST CONSTSIZE 'CONSTANTS))
	(MAPPRINS (LIST (ADD1 (QUOTIENT (DIFFERENCE (TIME) STARTTIME) 1750Q)) 'SECONDS))
	(LINEF 2Q)
   UNDF (COND [(NULL UNDFUNS) (GO UNDF1)])
	(COND [(HASPROP (CAR UNDFUNS) '*UNDEF) (SETQ UNDS (CONS (CAR UNDFUNS) UNDS))])
	(SETQ UNDFUNS (CDR UNDFUNS))
	(GO UNDF)
  UNDF1 (COND [(NULL UNDS) (GO GENF)])
	(MAPPRINS '(UNDEFINED FUNCTIONS))
	(LINEF 1Q)
	(MAPPRINS UNDS)
	(LINEF 2Q)
   GENF (COND [(NULL GENFUNS) (GO END)])
	(MAPPRINS '(GENERATED FUNCTIONS))
	(LINEF 1Q)
	(MAPPRINS GENFUNS)
	(LINEF 2Q)
    END (OUTC CHAN NIL)))
 EXPR)

(DEFPROP TYPEFN
 (LAMBDA (MESSAGE)
  (PROG (CHAN)
	(COND [(NULL SHOWNAMES) (RETURN NIL)])
	(SETQ CHAN (OUTC MSGCHAN NIL))
	(COND [(ATMARGIN) (LINEF 1Q)])
	(PRINS MESSAGE)
	(OUTC CHAN NIL)))
 EXPR)

(DEFPROP UNSPECIAL
 (LAMBDA (X) (MAPCAR (FUNCTION MAKEUNSPECIAL) X))
 FEXPR)

(DEFLIST ((COMPACTION DOACT) (MACRO ACTONMACRO)) COMPEFFECT)

(DEFLIST ((DE DODE)
	  (DF DODF)
	  (DM DODM)
	  (DECLARE EVAL)
	  (DEFPROP COMPDEF)
	  (LAP FLUSHLAP)
	  (SPECIAL EVAL)
	  (UNSPECIAL EVAL)
	  (*SUBR EVAL)
	  (*ARRAY EVAL)
	  (*FSUBR EVAL)
	  (*LSUBR EVAL)
	  (*EXPR EVAL)
	  (*FEXPR EVAL)
	  (*LEXPR EVAL)
	  (NOCALL EVAL)
	  (CALL EVAL)
	  (NOCOMPILE IGNORE)
	  (GLOBALMACRO EVAL))
	 COMPACTION)

(DEFPROP ; IGNORE COMPACTION)

(DEFPROP ;; IGNORE COMPACTION)

(DEFLIST ((EXPR DEFEXPR)
	  (FEXPR DEFFEXPR)
	  (MACRO DEFMACRO)
	  (SPECIAL EVAL)
	  (DEFACTION EVAL)
	  (*EXPR DO*EXPR)
	  (*FEXPR DO*FEXPR)
	  (*LEXPR DO*LEXPR)
	  (*SUBR EVAL)
	  (*FSUBR EVAL)
	  (*LSUBR EVAL)
	  (NOCALL EVALFLUSH)
	  (CALL FLUSHEXPR))
	 DEFACTION)

(DEFV MSGCHAN NIL)

(DEFV LISTING NIL)

(DEFV INDEV DSK:)

(DEFV OUTDEV DSK:)

(DEFV OUTEXT LAP)

(DEFV SHOWNAMES T)

{;; **** PASS1 ****⎇

(DEFPROP DOP1 (LAMBDA (XPR) ((GETPROP (CAR XPR) 'P1) XPR)) EXPR)

(DEFPROP GENFUN
 (LAMBDA (EXPR)
  (PROG (NAME ARGS CALL)
	(COND [(ATOM EXPR) (RETURN EXPR)])
	(COND [(NOT (EQ (CAR EXPR) 'LAMBDA)) (USERERR NOTFUNCTION-GENFUN)])
	(SETQ ARGS (CADR EXPR))
	(SETQ CALL (CADDRLAM EXPR))
	(COND [(AND [ATOM (CAR CALL)] [EQUAL ARGS (CDR CALL)]) (RETURN (CAR CALL))])
	(SETQ NAME (MAKESYM (NEXTSYM 'SUBFUN) (CURFUN)))
	(SETQ GENFUNS (CONS NAME GENFUNS))
	(RETURN (COMPFUNC NAME (LIST 'SUBR ARGS CALL) 'SUBR))))
 EXPR)

(DEFPROP MAPP1 (LAMBDA (ARGS) (MAPCAR (FUNCTION P1) ARGS)) EXPR)

(DEFPROP NEWNAME
 (LAMBDA (OLD)
  (PROG (NEW)
	(SETQ NEW (ASSOC OLD RENAMELIST))
	(COND [NEW (RETURN (CDR NEW))])
	(RETURN NIL)))
 EXPR)

(DEFPROP PASS1
 (LAMBDA (EXPR)
  (PROG (CURLOCVS LL RENAMELIST P1SCNT INPROG FOUNDFREE LOCVS)
	(SETQ P1CNT 1Q)
	(SETQ DEBUGXPR EXPR)
	(SETQ LOCVARS (SETQ SPECVARS NIL))
	(SETQ LL (P1BIND (CADR EXPR)))
	(COND [(GREATERP (LENGTH LL) NACS) (USERERR EXTRAARGS-PASS1)])
	(SETQ EXPR (LIST (CAR EXPR) LL (P1 (CADDRLAM EXPR))))
	(COND [(NOT (NULL FOUNDFREE)) (USERWARN (REVERSE FOUNDFREE) UNDECLARED FREE VARIABLES)])
	(SETQ LOCVS LOCVARS)
	(SETQ LOCVARS NIL)
   LOOP (COND [(NULL LOCVS) (RETURN EXPR)])
	(COND [(NOT (SPECIALP (CAAR LOCVS)))
	       (SETQ LOCVARS (CONS (CAR LOCVS) LOCVARS))
	       (SETPROP (CAAR LOCVS) 'LOCAL T)]
	      [T (SETQ SPECVARS (ADDTOLIST (CAAR LOCVS) SPECVARS))])
	(SETQ LOCVS (CDR LOCVS))
	(GO LOOP)))
 EXPR)

(DEFPROP PASS1FSUBR (LAMBDA (XPR) XPR) EXPR)

(DEFPROP PASS1FUNVAR
 (LAMBDA (XPR) (CONS (P1 (CAR XPR)) (P1SUBRARGS (CDR XPR))))
 EXPR)

(DEFPROP PASS1LSUBR
 (LAMBDA (XPR) (CONS (CAR XPR) (MAPP1 (CDR XPR))))
 EXPR)

(DEFPROP PASS1MACRO
 (LAMBDA (XPR) (P1 ((GETPROP (CAR XPR) 'MACRO) XPR)))
 EXPR)

(DEFPROP PASS1SUBR
 (LAMBDA (XPR)
  (PROG (NARGS)
	(COND [(NUMBERP (SETQ NARGS (GET (CAR XPR) '*SUBR)))
	       (SETQ NARGS (ADD1 (*DIF NARGS (LENGTH XPR))))
	       (COND [(*GREAT NARGS 0Q) (SETQ XPR (APPEND XPR (LISTNILS NARGS)))]
		     [(MINUSP NARGS) (USERERR TOOMANYARGS-PASS1SUBR)])])
	(RETURN (CONS (CAR XPR) (P1SUBRARGS (CDR XPR))))))
 EXPR)

(DEFPROP PASS1UNDEF
 (LAMBDA (XPR)
  (PROG2 (SETQ UNDFUNS (ADDTOLIST (CAR XPR) UNDFUNS)) (PASS1SUBR XPR)))
 EXPR)

(DEFPROP P1
 (LAMBDA (XPR)
  (PROG (TEM)
	(SETQ DEBUGXPR XPR)
	(COND [(ATOM XPR) (GO ATOM)])
	(COND [(ATOM (CAR XPR)) (GO ATOMC)])
	(COND [(EQ (CAAR XPR) 'LAMBDA) (RETURN (P1LAM XPR))])
	(COND [(EQ (CAAR XPR) 'LABEL) (RETURN (P1LABEL XPR))])
	(RETURN (CONS (P1 (CAR XPR)) (P1SUBRARGS (CDR XPR))))
   ATOM (COND [(CONSTANTP XPR) (RETURN (LIST 'QUOTE XPR))])
	(COND [(SETQ TEM (NEWNAME XPR)) (RETURN (P1 TEM))])
	(INCR P1CNT)
	(COND [(SPECIALP XPR) (SETQ SPECVARS (ADDTOLIST XPR SPECVARS)) (RETURN XPR)])
	(COND [(VARB XPR) (RETURN XPR)])
	(PUTLOC XPR P1CNT)
	(RETURN XPR)
  ATOMC (COND [(CONSTANTP (CAR XPR)) (USERERR CONSTFUN-P1)])
	(COND [(SETQ TEM (NEWNAME (CAR XPR))) (RETURN (P1 (CONS TEM (CDR XPR))))])
	(COND [(SETQ TEM (GETGET (CAR XPR) 'PASS1)) (RETURN ((PROPVAL TEM) XPR))])
	(COND [(OR [SPECIALP (CAR XPR)] [ASSOC (CAR XPR) LOCVARS])
	       (PUTPROP (CAR XPR) T '*FUNVAR)
	       (RETURN (CONS (P1 (CAR XPR)) (P1SUBRARGS (CDR XPR))))])
	(RETURN (P1ELSE XPR))))
 EXPR)

(DEFPROP P1BIND
 (LAMBDA (VARS)
  (PROG (VAR NEWVARS)
	(COND [(AND VARS [ATOM VARS]) (USERERR ATOMICVARLIST-P1BIND)])
   LOOP (COND [(NULL VARS) (RETURN (REVERSE NEWVARS))])
	(SETQ VAR (CAR VARS))
	(COND [(NOT (VARIABLEP VAR)) (USERERR NOTVARIABLE-P1BIND)])
	(COND [(MEMBER VAR NEWVARS) (USERWARN VAR REPEATED VARIABLE)])
	(COND [(SPECIALP VAR) (SETQ SPECVARS (ADDTOLIST VAR SPECVARS)) (GO ELOOP)]
	      [(ASSOC VAR LOCVARS) (RENAM VAR (SETQ VAR (GENVAR)))])
	(PUTLOC VAR 0Q)
	(SETQ CURLOCVS (CONS VAR CURLOCVS))
  ELOOP (SETQ NEWVARS (CONS VAR NEWVARS))
	(SETQ VARS (CDR VARS))
	(GO LOOP)))
 EXPR)

(DEFPROP P1BUG
 (LAMBDA (LOW HIGH PTR)
  (PROG (X)
   LOOP (COND [(NULL PTR) (RETURN NIL)])
	(SETQ X (CAR PTR))
	(COND [(GREATERP (CDR X) LOW) (RPLACD X HIGH)])
	(SETQ PTR (CDR PTR))
	(GO LOOP)))
 EXPR)

(DEFPROP P1COND
 (LAMBDA (XPR)
  (PROG (TEM CT PAIRS)
	(SETQ TEM LOCVARS)
	(SETQ CT P1CNT)
	(INCR P1CNT)
	(SETQ PAIRS (MAPCAR (FUNCTION MAPP1) (CDR XPR)))
	(INCR P1CNT)
	(P1BUG CT P1CNT TEM)
	(INCR P1CNT)
	(RETURN (CONS (CAR XPR) PAIRS))))
 EXPR)

(DEFPROP P1CONS
 (LAMBDA (XPR)
  (COND [(NOT (EQ (LENGTH (CDR XPR)) 2Q)) (USERERR ARGNO-P1CONS)]
	[(NULL (CADDR XPR)) (LIST 'NCONS (P1 (CADR XPR)))]
	[T (LIST 'CONS (P1 (CADR XPR)) (P1 (CADDR XPR)))]))
 EXPR)

(DEFPROP P1ELSE
 (LAMBDA (XPR)
  (PROG NIL
	(SETQ UNDFUNS (CONS (CAR XPR) UNDFUNS))
	(PUTPROP (CAR XPR) T '*UNDEF)
	(RETURN (CONS (CAR XPR) (P1SUBRARGS (CDR XPR))))))
 EXPR)

(DEFPROP P1EVAL
 (LAMBDA (XPR)
  (PROG (CDRXPR)
	(SETQ CDRXPR (P1SUBRARGS (CDR XPR)))
	(COND [(NOT (NULL (CDR CDRXPR))) (RETURN (CONS 'EVAL CDRXPR))])
	(RETURN (CONS '*EVAL CDRXPR))))
 EXPR)

(DEFPROP P1FUNCTION
 (LAMBDA (XPR)
  (LIST (COND [(EQ (CAR XPR) 'FUNCTION) 'QUOTE] [T (CAR XPR)])
	(GENFUN (CADR XPR))))
 EXPR)

(DEFPROP P1GO
 (LAMBDA (XPR)
  (PROG NIL
	(COND [(NOT INPROG) (USERERR NOTINPROG-P1GO)])
	(COND [(ATOM (CADR XPR)) (RETURN XPR)])
	(RETURN (LIST (CAR XPR) (P1 (CADR XPR))))))
 EXPR)

(DEFPROP P1LABEL
 (LAMBDA (XPR)
  (PROG (FN)
	(INITPROP (CADAR XPR) 'FUNVAR T)
	(SETQ FN (P1 (LIST 'FUNCTION (CADDAR XPR))))
	(DELETEPROP (CADAR XPR) 'FUNVAR)
	(RETURN (P1 (LIST 'PROG
			  (LIST (CADAR XPR))
			  (LIST 'SETQ (CADAR XPR) FN)
			  (LIST 'RETURN (CONS (CADAR XPR) (CDR XPR))))))))
 EXPR)

(DEFPROP P1LAM
 (LAMBDA (XPR)
  ((LAMBDA (RENAMELIST CURLOCVS)
    (PROG (ARGS LAML BODY INPROG)
	  (SETQ ARGS (P1SUBRARGS (CDR XPR)))
	  (SETQ LAML (P1BIND (CADAR XPR)))
	  (SETQ BODY (P1 (CADDRLAM (CAR XPR))))
	  (INCR P1CNT)
	  (RETURN (CONS (LIST 'LAMBDA LAML BODY) ARGS))))
   RENAMELIST 
   CURLOCVS))
 EXPR)

(DEFPROP P1PROG
 (LAMBDA (XPR)
  ((LAMBDA (RENAMELIST CURLOCVS)
    (PROG (TAGLIST P1SCNT PR TEM P1LL INPROG)
	  (COND [(NULL (CDR XPR)) (USERERR PROGTOOSHORT-P1PROG)])
	  (SETQ INPROG T)
	  (SETQ XPR (CDR XPR))
	  (SETQ P1LL (P1BIND (CAR XPR)))
	  (SETQ TEM LOCVARS)
	  (SETQ P1SCNT (INCR P1CNT))
    LOOP1 (SETQ XPR (CDR XPR))
	  (COND [(NULL XPR) (GO END1)])
	  (INCR P1CNT)
	  (COND [(ATOM (CAR XPR))
		 (COND [(ASSOC (CAR XPR) TAGLIST) (USERWARN (CAR XPR) MULTIPLY DEFINED TAG)])
		 (SETQ TAGLIST (CONS (CONS (CAR XPR) (GENTAG)) TAGLIST))
		 (SETQ PR (CONS (CAR XPR) PR))]
		[T (SETQ PR (CONS (P1 (CAR XPR)) PR))])
	  (GO LOOP1)
     END1 (INCR P1CNT)
	  (P1BUG P1SCNT P1CNT TEM)
	  (SETQ TEM (GETPROP 'LOCVARS 'VALUE))
     LOOP (COND [(NULL (CDR TEM)) (GO END)])
	  (COND [(AND [MEMBER (CAADR TEM) P1LL] [ZEROP (CDADR TEM)])
		 (USERWARN (CAADR TEM) UNUSED PROG VARIABLE)
		 (SETQ SPECVARS (ADDTOLIST (CAADR TEM) SPECVARS))
		 (SETQ SPECIALS (ADDTOLIST (CAADR TEM) SPECIALS))
		 (MAKESPECIAL (CAADR TEM))])
    ELOOP (SETQ TEM (CDR TEM))
	  (GO LOOP)
      END (INCR P1CNT)
	  (RETURN (MCONS 'PROG TAGLIST P1LL (REVERSE PR)))))
   RENAMELIST 
   CURLOCVS))
 EXPR)

(DEFPROP P1RETURN
 (LAMBDA (XPR)
  (COND [(NOT INPROG) (USERERR NOTINPROG-P1RETURN)]
	[T (LIST 'RETURN (P1 (COND [(NULL (CDR XPR)) NIL] [T (CADR XPR)])))]))
 EXPR)

(DEFPROP P1SETQ
 (LAMBDA (XPR)
  (PROG (VAR TEM VAL)
	(COND [(NOT (VARIABLEP (CADR XPR))) (USERERR NOTVARIABLE-P1SETQ)])
	(SETQ VAR (COND [(SETQ TEM (NEWNAME (CADR XPR))) TEM] [T (CADR XPR)]))
	(VARB VAR)
	(SETQ VAL (P1 (CADDR XPR)))
	(INCR P1CNT)
	(INCR P1CNT)
	(RETURN (LIST 'SETQ VAR VAL))))
 EXPR)

(DEFPROP P1STORE
 (LAMBDA (XPR)
  (PROG (ARG1 ARG2)
	(SETQ ARG2 (P1 (CADDR XPR)))
	(SETQ ARG1 (P1 (CADR XPR)))
	(RETURN (LIST (CAR XPR) ARG1 ARG2))))
 EXPR)

(DEFPROP P1SUBRARGS
 (LAMBDA (ARGS)
  (COND [(GREATERP (LENGTH ARGS) NACS) (USERERR EXTRAARGS-P1SUBRARGS)]
	[T (MAPP1 ARGS)]))
 EXPR)

(DEFPROP PUTLOC
 (LAMBDA (IVAR NUMBER)
  (PROG (TEM)
	(SETQ TEM (ASSOC IVAR LOCVARS))
	(COND [TEM (RETURN (RPLACD TEM NUMBER))])
	(RETURN (SETQ LOCVARS (CONS (CONS IVAR NUMBER) LOCVARS)))))
 EXPR)

(DEFPROP RENAM
 (LAMBDA (OLD NEW) (SETQ RENAMELIST (CONS (CONS OLD NEW) RENAMELIST)))
 EXPR)

(DEFPROP SPECIALP (LAMBDA (VAR) (HASPROP VAR 'SPECIAL)) EXPR)

(DEFPROP VARB
 (LAMBDA (X)
  (PROG NIL
	(COND [(MEMBER X CURLOCVS) (RETURN NIL)] [(SPECIALP X) (GO SPEC)])
	(SETQ FOUNDFREE (CONS X FOUNDFREE))
	(SETQ SPECIALS (CONS X SPECIALS))
	(MAKESPECIAL X)
   SPEC (SETQ SPECVARS (ADDTOLIST X SPECVARS))
	(RETURN T)))
 EXPR)

(DEFPROP VARIABLEP
 (LAMBDA (EX) (AND [ATOM EX] [NOT (CONSTANTP EX)]))
 EXPR)

(DEFLIST ((EXPR PASS1SUBR)
	  (*EXPR PASS1SUBR)
	  (SUBR PASS1SUBR)
	  (*SUBR PASS1SUBR)
	  (*UNDEF PASS1UNDEF)
	  (*LEXPR PASS1LSUBR)
	  (LSUBR PASS1LSUBR)
	  (*LSUBR PASS1LSUBR)
	  (FEXPR PASS1FSUBR)
	  (*FEXPR PASS1FSUBR)
	  (FSUBR PASS1FSUBR)
	  (*FSUBR PASS1FSUBR)
	  (P1 DOP1)
	  (FUNVAR PASS1FUNVAR)
	  (MACRO PASS1MACRO))
	 PASS1)

(DEFLIST ((COND P1COND)
	  (GO P1GO)
	  (PROG P1PROG)
	  (EVAL P1EVAL)
	  (SETQ P1SETQ)
	  (STORE P1STORE)
	  (CONS P1CONS)
	  (*FUNCTION P1FUNCTION)
	  (FUNCTION P1FUNCTION)
	  (RETURN P1RETURN))
	 P1)

(DEFV SPECIALS NIL)

(DEFV PDL NIL)

(DEFV ACS NIL)

(DEFV LDLST NIL)

(DEFV SPLDLST NIL)

(DEFV CCLST NIL)

{;; Internal macros:⎇

(DEFPROP INMACRO PASS1INMACRO PASS1)

(DEFPROP PASS1INMACRO
 (LAMBDA (XPR) (P1 ((GETPROP (CAR XPR) 'INMACRO) XPR)))
 EXPR)

(DEFPROP INMACRO
 (LAMBDA (DF) (COMPFUNC (CADR DF) (CONS 'SUBR (CDADDR DF)) 'INMACRO))
 DEFACTION)

(DEFPROP APPEND
 (LAMBDA (L)
  (COND [(NULL (CDR L)) NIL]
	[(NULL (CDDR L)) (CADR L)]
	[T (LIST '*APPEND (CADR L) (CONS (CAR L) (CDDR L)))]))
 INMACRO)

(DEFPROP LIST
 (LAMBDA (L)
  (COND [(NULL (CDR L)) NIL]
	[(NULL (CDDR L)) (CONS 'NCONS (CDR L))]
	[T (LIST 'CONS (CADR L) (CONS (CAR L) (CDDR L)))]))
 INMACRO)

(DEFPROP NOT (LAMBDA (L) (CONS 'NULL (CDR L))) INMACRO)

(DEFPROP =0 (LAMBDA (L) (LIST 'EQ (CADR L) 0Q)) INMACRO)

{;; **** PASS2 ****⎇

(DEFPROP ACEFFECTS
 (LAMBDA (FN)
  (COND [(SETQ FN (SEEKPROP FN 'ACS)) (PROPVAL FN)] [T ALLACS]))
 EXPR)

(DEFPROP ACNUMP
 (LAMBDA (X) (AND [NUMBERP X] [GREATERP X 0Q] [LESSP X (ADD1 NACS)]))
 EXPR)

(DEFPROP BINDVARS
 (LAMBDA (VARS LAMBDAP)
  (PROG (VAR ACNUM SPFLG)
	(SETQ ACNUM 1Q)
      A (COND [(NULL VARS) (RETURN SPFLG)])
	(SETQ VAR (CAR VARS))
	(COND [(SPECVARP VAR) (GO SP1)]
	      [(ASSOC VAR LOCVARS) (GO LV1)]
	      [T (COMPERR FUNNYVAR-BINDVARS) (GO SP2)])
    LV1 (COND [LAMBDAP (SETSLOT ACNUM (LIST VAR))])
    SP2 (SETQ ACNUM (ADD1 ACNUM))
	(SETQ VARS (CDR VARS))
	(GO A)
    SP1 (COND [(NOT PRGSPFLG) (GO B)])
    SP3 (OUTINST (LIST 0Q (COND [LAMBDAP ACNUM] [T 0Q]) (LIST 'SPECIAL VAR) 'S))
	(GO LV1)
      B (SETQ PRGSPFLG (SETQ SPFLG T))
	(OUTINST '(JSP 6Q SPECBIND))
	(GO SP3)))
 EXPR)

(DEFPROP BOOLCOND
 (LAMBDA (EXP VALAC TAG FLAG)
  (PROGN (P2COND1 (CDR EXP) VALAC NIL FLAG TAG)
	 (INCR P2CNT)
	 (INCR P2CNT)
	 (RSLSET TAG)))
 EXPR)

(DEFPROP BOOLEQ
 (LAMBDA (EXP VALAC TAG FLAG)
  (PROGN (BOOLEQ1 (CDR EXP) VALAC TAG FLAG) (OUTJRST TAG) (RSLSET TAG)))
 EXPR)

(DEFPROP BOOLEQ1
 (LAMBDA (EXP VALAC TAG F)
  (PROG (ARG1 ARG2 LOC1 LOC2 AC MEM)
	(COND [(NOT (EQ (LENGTH EXP) 2Q)) (USERERR ARGNOERR-BOOLEQ1)])
	(SETQ ARG1 (COMP (CAR EXP) (FREEAC)))
	(SETQ ARG2 (COMP (CADR EXP) (FREEAC)))
	(SETQ LOC2 (LOC ARG2))
	(SETQ LOC1 (LOC ARG1))
	(RST TAG)
	(COND [(ACNUMP LOC1) (SETQ AC LOC1) (SETQ MEM (LOC ARG2))]
	      [(ACNUMP LOC2) (SETQ AC LOC2) (SETQ MEM (LOC ARG1))]
	      [T (LOADARG (SETQ AC (FREEAC)) ARG1) (SETQ MEM (LOC ARG2))])
	(REMOVL ARG1)
	(REMOVL ARG2)
	(COND [(AND [DVP (SLOTCONT AC)] [NUMBERP MEM] [LESSP MEM 1Q])
	       (SETQ ARG1 (SLOTCONT MEM))
	       (LOADARG (SETQ MEM (FREEAC)) ARG1)])
	(SAVEACS)
	(OUT1 (COND [F 'CAMN] [T 'CAME]) AC MEM)))
 EXPR)

(DEFPROP BOOLEXPR
 (LAMBDA (EXP VALAC TAG FLAG MINDEPTH)
  (PROG (TEM)
	(COND [(ATOM EXP) (GO ELSE)])
	(COND [(SETQ TEM (SEEKPROP (CAR EXP) 'BOOL)) (RETURN ((PROPVAL TEM) EXP VALAC TAG FLAG))])
   ELSE (SETQ EXP (PUTINAC (COMP EXP VALAC) VALAC))
	(OUTCJMP FLAG EXP TAG)
	(COND [FLAG (RSLSET TAG) (SETSLOT EXP ''NIL)]
	      [T (SETQ FLAG (SLOTCONT EXP))
		 (SETSLOT EXP ''NIL)
		 (RSLSET TAG)
		 (SETSLOT EXP FLAG)])))
 EXPR)

(DEFPROP BOOLNULL
 (LAMBDA (EXP VALAC TAG FLAG)
  (BOOLEXPR (CADR EXP) VALAC TAG (NOT FLAG) MINDEPTH))
 EXPR)

(DEFPROP BOOLQUOTE
 (LAMBDA (EXP VALAC TAG FLAG)
  (COND [(EQ FLAG (NOT (NULL (CADR EXP)))) (OUTJRST TAG) (RSLSET TAG)]))
 EXPR)

(DEFPROP BOOLVALUE
 (LAMBDA (VALAC EFFECTS TAG)
  (PROG NIL
	(COND [(NOT EFFECTS) (OUT1 'TDZA VALAC VALAC)])
	(OUTENDTAG TAG)
	(COND [(NOT EFFECTS) (OUT1 'MOVEI VALAC ''T)])
	(RETURN (MARKVAL VALAC EFFECTS))))
 EXPR)

(DEFPROP CALLFSUBR
 (LAMBDA (XPR VALAC EFFECTS)
  (PROG (FUN ARGS VAL)
	(SETQ FUN (CAR XPR))
	(SETQ ARGS (CDR XPR))
	(CLEAR2BOTH)
	(LOADARG FARGAC (LIST 'QUOTE ARGS))
	(PROTECTACS FUN)
	(SETQ VAL (MARKVAL VALUEAC EFFECTS))
	(OUTCALL 17Q FUN)
	(RETURN VAL)))
 EXPR)

(DEFPROP CALLFUNARGS
 (LAMBDA (XPR VALAC EFFECTS)
  (PROG (FUN ARGS FUNARGS LOCS VAL)
	(SETQ FUN (CAR XPR))
	(SETQ ARGS (CDR XPR))
	(SETQ FUNARGS (COMP FUN VALAC))
	(SETQ LOCS (COMPARGS ARGS))
	(CLRCCLST LOCS)
	(LOADSUBRARGS LOCS)
	(CLEAR2BOTH)
	(CLEARACS)
	(SETQ VAL (MARKVAL VALUEAC EFFECTS))
	(OUTCALLF (LENGTH LOCS) (LOC FUNARGS))
	(REMOVL FUNARGS)
	(RETURN VAL)))
 EXPR)

(DEFPROP CALLLSUBR
 (LAMBDA (XPR VALAC EFFECTS)
  (PROG (FUN ARGS NARGS HOME INST RETTAG TEM VAL)
	(SETQ FUN (CAR XPR))
	(SETQ ARGS (CDR XPR))
	(CLEAR1)
	(SETQ NARGS (LENGTH ARGS))
	(SLOTPUSH '(NIL . TAKEN))
	(OUTPUSH (GENCONST 0Q 0Q (SETQ RETTAG (GENTAG)) 0Q))
   LOOP (COND [(NULL ARGS) (GO CALL)])
	(SETQ HOME (TOPCOPY PDL))
	(SETQ INST (COMP (CAR ARGS) VALAC))
	(RESTOR HOME)
	(SETQ TEM (LOC INST))
	(SLOTPUSH '(NIL . TAKEN))
	(OUTPUSH TEM)
	(REMOVL INST)
	(SETQ ARGS (CDR ARGS))
	(GO LOOP)
   CALL (SETQ TEM (PDLDEPTH))
	(SAVEACS)
	(COND [(NOT (EQ (PDLDEPTH) TEM)) (COMPERR PDLTOOLONG-LSUBRCALL)])
	(OUTINST (LIST 'MOVNI 6Q NARGS))
  LLOOP (SLOTPOP)
	(COND [(ZEROP NARGS) (GO CALL1)])
	(SETQ NARGS (SUB1 NARGS))
	(GO LLOOP)
  CALL1 (CLEAR2BOTH)
	(CLEARACS)
	(SETQ VAL (MARKVAL VALUEAC EFFECTS))
	(OUTJCALL 16Q FUN)
	(OUTTAG RETTAG)
	(RETURN VAL)))
 EXPR)

(DEFPROP CALLSUBR
 (LAMBDA (XPR VALAC EFFECTS)
  (PROG (FUN ARGS NARGS LOCS TEM VAL)
	(SETQ FUN (CAR XPR))
	(SETQ ARGS (CDR XPR))
	(SETQ LOCS (COMPARGS ARGS))
	(SETQ NARGS (LENGTH LOCS))
	(COND [(AND [SETQ TEM (SEEKPROP FUN 'COMMU)]
		    [EQ NARGS 2Q]
		    [EQ (ILOC (CAR LOCS) VALUEAC) VALUEAC])
	       (SETQ LOCS (REVERSE LOCS))
	       (SETQ FUN (PROPVAL TEM))])
	(SETQ TEM (SIDEEFFECTS FUN))
	(COND [TEM (CLRCCLST LOCS)])
	(LOADSUBRARGS LOCS)
	(COND [TEM (CLEAR2BOTH)])
	(PROTECTACS FUN)
	(SETQ VAL (MARKVAL VALUEAC EFFECTS))
	(OUTCALL NARGS FUN)
	(RETURN VAL)))
 EXPR)

(DEFPROP CLEAR1
 (LAMBDA NIL (PROGN (CLEAR1BOTH) (SAVEACS) (CLRPVARS)))
 EXPR)

(DEFPROP CLEAR1BOTH (LAMBDA NIL (PROG NIL (CLRCCLST1) (CLRSPLD))) EXPR)

(DEFPROP CLEAR2BOTH (LAMBDA NIL (PROG NIL (CLRCCLST2) (CLRSPLD))) EXPR)

(DEFPROP CLEARAC
 (LAMBDA (ACNO) (PROG NIL (CPUSH ACNO) (SETSLOT ACNO NIL)))
 EXPR)

(DEFPROP CLEARITALL (LAMBDA NIL (PROG NIL (CLEAR2BOTH) (CLEARACS))) EXPR)

(DEFPROP CLEARACS
 (LAMBDA NIL
  (PROG (ACNO)
	(SETQ ACNO NACS)
   LOOP (COND [(ZEROP ACNO) (RETURN NIL)])
	(CLEARAC ACNO)
	(SETQ ACNO (SUB1 ACNO))
	(GO LOOP)))
 EXPR)

(DEFPROP CLRCCLST
 (LAMBDA (DATA)
  (PROG (CCL)
	(SETQ CCL CCLST)
   LOOP (COND [(NULL CCL) (RETURN NIL)])
	(COND [(ASSOC (CAAR CCL) DATA) (GO ELOOP)])
	(CSFUN (CAR CCL))
  ELOOP (SETQ CCL (CDR CCL))
	(GO LOOP)))
 EXPR)

(DEFPROP CLRCCLST1
 (LAMBDA NIL
  (PROG (CCL)
	(SETQ CCL CCLST)
   LOOP (COND [(NULL CCL) (RETURN NIL)])
	(CSFUN (CAR CCL))
	(SETQ CCL (CDR CCL))
	(GO LOOP)))
 EXPR)

(DEFPROP CLRCCLST2
 (LAMBDA NIL
  (PROG NIL
   LOOP (COND [(NULL CCLST) (RETURN NIL)])
	(CSFUN (CAR CCLST))
	(SETQ CCLST (CDR CCLST))
	(GO LOOP)))
 EXPR)

(DEFPROP CLRPVARS
 (LAMBDA NIL
  (PROG NIL
	(COND [(NOT PROGSW) (RETURN NIL)])
	(SETQ PROGSW NIL)
   LOOP (COND [(NULL PROGVARS)
	       (SETQ PRSSL (TOPCOPY PDL))
	       (SETQ MINDEPTH (PDLDEPTH))
	       (RETURN NIL)])
	(INITZ (CAR PROGVARS))
	(SETQ PROGVARS (CDR PROGVARS))
	(GO LOOP)))
 EXPR)

(DEFPROP CLRSPLD
 (LAMBDA NIL
  (PROG NIL
   LOOP (COND [(NULL SPLDLST) (RETURN NIL)])
	(CLRSPVAR (CAAR SPLDLST))
	(SETQ SPLDLST (CDR SPLDLST))
	(GO LOOP)))
 EXPR)

(DEFPROP CLRSPVAR
 (LAMBDA (VAR)
  (PROG (LOC L)
	(SETQ LOC (ILOC (SETQ L (CONS VAR P2CNT)) VALUEAC))
	(COND [(NOT (NUMBERP LOC)) (SLOTPUSH L) (OUTPUSH (LIST 'SPECIAL VAR))]
	      [(ACNUMP LOC) (SLOTPUSH L) (OUTPUSH LOC)])
	(RETURN NIL)))
 EXPR)

(DEFPROP COMP (LAMBDA (XPR VALAC) (COMPEXPR XPR VALAC NIL)) EXPR)

(DEFPROP COMPARGS
 (LAMBDA (ARGS)
  (PROG (ARGNO RESULT)
	(SETQ ARGNO 0Q)
   LOOP (COND [(NULL ARGS) (RETURN RESULT)])
	(SETQ ARGNO (ADD1 ARGNO))
	(SETQ RESULT (CONS (COMP (CAR ARGS) ARGNO) RESULT))
	(SETQ ARGS (CDR ARGS))
	(GO LOOP)))
 EXPR)

(DEFPROP COMPE (LAMBDA (XPR) (REMOVL (COMPEXPR XPR (FREEAC) T))) EXPR)

(DEFPROP COMPEXPR
 (LAMBDA (XPR VALAC EFFECTS)
  (PROG (TEM)
	(SETQ DEBUGXPR XPR)
	(COND [(ATOM XPR) (GO ATOM)])
	(COND [(ATOM (CAR XPR)) (GO ATOMC)])
	(COND [(EQ (CAAR XPR) 'LAMBDA) (RETURN (INTERNALLAMBDA XPR VALAC EFFECTS))])
	(RETURN (CALLFUNARGS XPR VALAC EFFECTS))
   ATOM (INCR P2CNT)
	(COND [(MEMQ XPR PROGVARS) (RETURN ''NIL)])
	(SETQ TEM (CONS XPR P2CNT))
	(COND [(SPECVARP XPR) (SETQ SPLDLST (CONS TEM SPLDLST))])
	(SETQ LDLST (CONS TEM LDLST))
	(RETURN TEM)
  ATOMC (COND [(SETQ TEM (GETGET (CAR XPR) 'PASS2)) (RETURN ((PROPVAL TEM) XPR VALAC EFFECTS))])
	(COND [(OR [SPECVARP (CAR XPR)] [ASSOC (CAR XPR) LOCVARS])
	       (RETURN (CALLFUNARGS XPR VALAC EFFECTS))])
	(RETURN (P2ELSE XPR VALAC EFFECTS))))
 EXPR)

(DEFPROP COPT
 (LAMBDA (FUN AC ARGLOC)
  (PROG (CCL TEM YLOC)
	(SETQ YLOC (ILOC ARGLOC AC))
	(SETQ CCL CCLST)
   LOOP (COND [(NULL CCL) (RETURN NIL)]
	      [(AND [EQ FUN (CADAR CCL)]
		    [EQUAL (ILOC (CDDAR CCL) AC) YLOC]
		    [ILOC (SETQ TEM (LIST (CAAR CCL))) AC])
	       (RETURN TEM)])
	(SETQ CCL (CDR CCL))
	(GO LOOP)))
 EXPR)

(DEFPROP CPUSH
 (LAMBDA (ACNO)
  (PROG (TEMPDL SLOTNO SLOTCON HOLDSLOT)
	(COND [(NOT (DVP (SETQ SLOTCON (SLOTCONT ACNO)))) (RETURN NIL)])
	(COND [(LESSP ACNO 1Q) (GO MAKE)])
  START (SETQ SLOTNO 0Q)
	(SETQ TEMPDL PDL)
   LOOP (COND [(NULL TEMPDL) (GO NONE)]
	      [(EQUAL SLOTCON (CAR TEMPDL)) (RETURN NIL)]
	      [(DVP (CAR TEMPDL)) (GO ELOOP)]
	      [(EQ (CAR SLOTCON) (CAAR TEMPDL)) (GO FOUND)]
	      [T (SETQ HOLDSLOT SLOTNO)])
  ELOOP (SETQ TEMPDL (CDR TEMPDL))
	(SETQ SLOTNO (SUB1 SLOTNO))
	(GO LOOP)
  FOUND (SETSLOT SLOTNO SLOTCON)
	(COND [(NULL (CDR SLOTCON)) (SETSLOT ACNO (CONS (CAR SLOTCON) 'DUP))])
	(OUTMOVEM ACNO SLOTNO)
	(RETURN NIL)
   NONE (COND [HOLDSLOT (SETQ SLOTNO HOLDSLOT) (GO FOUND)])
   MAKE (COND [(AND PROGSW [NOT (ASSOC (CAR SLOTCON) LOCVARS)])
	       (SETQ TEMPDL (PDLDEPTH))
	       (CLRPVARS)
	       (COND [(LESSP ACNO 1Q) (SETQ ACNO (PLUS ACNO (DIFFERENCE TEMPDL (PDLDEPTH))))])])
	(COND [(NULL (CDR SLOTCON)) (SETSLOT ACNO (CONS (CAR SLOTCON) 'DUP))])
	(SLOTPUSH SLOTCON)
	(OUTPUSH ACNO)
	(RETURN NIL)))
 EXPR)

(DEFPROP CSFUN
 (LAMBDA (L) (PROG (Y) (AND [SETQ Y (ASSOC (CAR L) LDLST)] [LOC Y])))
 EXPR)

(DEFPROP CSTEP
 (LAMBDA (FUN AC ARGLOC)
  (PROG (TEM)
	(COND [(NULL FUN) (RETURN (LIST ARGLOC))]
	      [(SETQ TEM (COPT FUN AC ARGLOC)) (RETURN (LIST TEM))])
	(RETURN (CONS (CAR (SETQ TEM (GETPROP FUN 'CARCDR)))
		      (CSTEP (CDR TEM) AC ARGLOC)))))
 EXPR)

(DEFPROP DOP2
 (LAMBDA (XPR VALAC EFFECTS) ((GETPROP (CAR XPR) 'P2) XPR VALAC EFFECTS))
 EXPR)

(DEFPROP DVP
 (LAMBDA (X)
  (PROG (Y Z)
	(COND [(NULL X) (RETURN NIL)])
	(COND [(EQ (CAR X) 'QUOTE) (RETURN NIL)])
	(COND [(EQ (CDR X) 'DUP) (RETURN NIL)])
	(COND [(EQ (CDR X) 'TAKEN) (RETURN T)])
	(COND [(AND [SPECVARP (CAR X)] [NULL (CDR X)]) (RETURN NIL)])
	(COND [(AND [SETQ Y (ASSOC (CAR X) LOCVARS)]
		    [NULL (CDR X)]
		    [LESSP P2CNT (CDR Y)])
	       (RETURN T)])
	(SETQ Z LDLST)
   LOOP (COND [(NULL Z) (SETQ Z VARLIST) (GO LOOP1)])
	(COND [(AND [EQ (CAAR Z) (CAR X)] [EQUAL (LOC X) (LOC (CAR Z))])
	       (RETURN T)])
	(SETQ Z (CDR Z))
	(GO LOOP)
  LOOP1 (COND [(NULL Z) (RETURN NIL)]
	      [(AND [EQ (CAR X) (CAAR Z)] [DVP (CONS (CDAR Z) (CDR X))])
	       (RETURN T)])
	(SETQ Z (CDR Z))
	(GO LOOP1)))
 EXPR)

(DEFPROP EQUIVTAG
 (LAMBDA (PTAG)
  (PROG (LTAG)
	(COND [(SETQ LTAG (ASSOC PTAG GOLIST)) (RETURN (CDR LTAG))])
	(USERWARN PTAG UNDEFINED TAG)
	(RETURN EXIT)))
 EXPR)

(DEFPROP EXITBUM
 (LAMBDA (SPECFLAG)
  (PROG (TEM1 TEM2)
	(COND [(NULL LASTOUT)]
	      [(SETQ TEM1 (ASSOC (CAAR LASTOUT) '((CALL JCALL) (PUSHJ JRST))))
	       (SETQ TEM2 (CAR LASTOUT))
	       (SETQ LASTOUT NIL)
	       (KILLPDL)
	       (OUTINST TEM2)
	       (COND [(NOT SPECFLAG)
		      (SETQ TEM2 (CAR LASTOUT))
		      (SETQ LASTOUT NIL)
		      (OUTINST (MCONS (CADR TEM1) (SUBST 0Q 'P (CADR TEM2)) (CDDR TEM2)))
		      (RETURN NIL)])])
	(KILLPDL)
	(COND [SPECFLAG (OUTINST '(JRST 0Q SPECSTR))] [T (OUTINST '(POPJ P))])))
 EXPR)

(DEFPROP FREEAC (LAMBDA NIL (FREEAC1 NACS)) EXPR)

(DEFPROP FREEAC1
 (LAMBDA (BEST)
  (PROG (ACNO)
	(SETQ ACNO NACS)
   LOOP (COND [(=0 ACNO)
	       (COND [(NULL BEST) (RETURN NIL)] [T (CPUSH BEST) (RETURN BEST)])])
	(COND [(NOT (DVP (CAR (NTH ACS ACNO)))) (RETURN ACNO)])
	(SETQ ACNO (SUB1 ACNO))
	(GO LOOP)))
 EXPR)

(DEFPROP FINDFREEAC (LAMBDA NIL (FREEAC1 NIL)) EXPR)

(DEFPROP FREEZE
 (LAMBDA (VAR) (PROG NIL (FREEZE1 VAR ACS) (FREEZE1 VAR PDL)))
 EXPR)

(DEFPROP FREEZE1
 (LAMBDA (X Z)
  (PROG NIL
     LP (COND [(NULL Z) (RETURN NIL)]
	      [(EQ X (CAAR Z))
	       (COND [(OR [NULL (CDAR Z)] [EQ (CDAR Z) 'DUP]) (RPLACA Z (CONS X P2CNT))])])
	(SETQ Z (CDR Z))
	(GO LP)))
 EXPR)

(DEFPROP GENCONST
 (LAMBDA (OP AC AD IN)
  (COND [(NEEDS AD)
	 (OUTSTAT (LIST 'MOVEI 'D AD 'S))
	 (COND [(OR [NEQ OP 0Q] [NEQ AC 0Q] [NEQ IN 0Q]) (COMPERR BAD-S-REG-GENCONST)])
	 'D]
	[T (LIST 'C OP AC AD IN)]))
 EXPR)

(DEFPROP GETSLOT
 (LAMBDA (NO)
  (COND [(NOT (NUMBERP NO)) (COMPERR NOTSLOT-GETSLOT)]
	[(GREATERP NO NACS) (PRINTMSG (LIST NO)) (COMPERR NOTAC-GETSLOT)]
	[(GREATERP NO 0Q) (NTHCDR (SUB1 NO) ACS)]
	[(GREATERP (ABS NO) (PDLDEPTH)) (PRINTMSG (LIST NO)) (COMPERR NOTONPDL-GETSLOT)]
	[(NTHCDR (MINUS NO) PDL)]))
 EXPR)

(DEFPROP ILOC
 (LAMBDA (X AC)
  (PROG (CNTR BEST BESTNO SL SLOT CNT XCNT)
	(COND [(NULL AC) (GO LOOK)])
	(SETQ SLOT (SLOTCONT AC))
	(AND [EQ (CDR SLOT) 'DUP] [SETQ SLOT (LIST (CAR SLOT))])
	(COND [(EQUAL X SLOT) (RETURN AC)])
   LOOK (COND [(EQ (CAR X) 'QUOTE) (RETURN (LIST X))])
	(SETQ SL (SLOTLIST))
	(SETQ CNTR 1Q)
	(SETQ BESTNO (ADD1 P2CNT))
	(SETQ XCNT (COND [(NUMBERP (CDR X)) (CDR X)] [T P2CNT]))
   LOOP (COND [(NULL SL) (GO EXIT)])
	(SETQ SLOT (CAR SL))
	(COND [(AND SLOT [EQ (CAR SLOT) (CAR X)]) (GO ISONE)])
  ELOOP (SETQ SL (CDR SL))
	(SETQ CNTR (ADD1 CNTR))
	(GO LOOP)
   EXIT (COND [(NOT (GREATERP BESTNO P2CNT)) (GO RETN)])
	(COND [(SPECIALP (CAR X)) (RETURN (LIST 'SPECIAL (CAR X)))])
	(RETURN NIL)
  ISONE (COND [(EQ (CDR SLOT) 'TAKEN)
	       (COND [(EQUAL X SLOT) (SETQ BEST CNTR) (GO RETN)] [T (GO ELOOP)])])
	(SETQ CNT (COND [(NUMBERP (CDR SLOT)) (CDR SLOT)] [T P2CNT]))
	(COND [(AND [NOT (LESSP CNT XCNT)] [LESSP CNT BESTNO]) (SETQ BESTNO CNT) (SETQ BEST CNTR)])
	(GO ELOOP)
   RETN (RETURN (COND [(NOT (GREATERP BEST NACS)) BEST]
		      [T (PLUS (MINUS BEST) NACS 1Q)]))))
 EXPR)

(DEFPROP ILOC1
 (LAMBDA (X AC)
  (PROG (Z)
	(COND [(SETQ Z (ILOC X AC)) (RETURN Z)])
	(COND [(MEMBER (CAR X) PROGVARS) (RETURN '('NIL))])
	(COND [(SETQ Z (ASSOCR (CAR X) VARLIST)) (RETURN (ILOC1 (CONS (CAR Z) (CDR X)) AC))])
	(COND [(SETQ Z (ASSOC (CAR X) CCLST))
	       (RETURN (LOADCARCDR Z (COND [(NULL AC) (GET (CAR X) 'CCAC)] [T AC])))])
	(PRINTMSG (LIST X))
	(COMPERR LOSTVAR-ILOC1)))
 EXPR)

(DEFPROP INITZ
 (LAMBDA (X) (PROG NIL (SLOTPUSH (LIST X)) (OUTPUSH '('NIL))))
 EXPR)

(DEFPROP INTERNALLAMBDA
 (LAMBDA (XPR VALAC EFFECTS)
  (PROG (LAMXPR LAMARGS SF LAMVARS TL TEM)
	(SETQ LAMXPR (CAR XPR))
	(SETQ LAMVARS (CADR LAMXPR))
	(SETQ LAMARGS (REVERSE (COMPARGS (CDR XPR))))
	(COND [(NOT (EQUAL (LENGTH LAMVARS) (LENGTH LAMARGS))) (USERERR ARGNOERR-INTERNALLAMBDA)])
      A (COND [(NULL LAMVARS) (GO B)])
	(SETQ TL (LOC (CAR LAMARGS)))
	(REMOVL (CAR LAMARGS))
	(COND [(SPECVARP (SETQ TEM (CAR LAMVARS)))
	       (SETQ SF T)
	       (COND [(OR [NOT (NUMBERP TL)] [LESSP TL 1Q])
		      (LOADARG (SETQ TL (FREEAC)) (CAR LAMARGS))])
	       (COND [(ASSOC TEM SPLDLST) (CLRSPVAR TEM) (REMSPVAR TEM)])]
	      [(OR [NOT (NUMBERP TL)] [DVP (SETQ TEM (SLOTCONT TL))])
	       (SLOTPUSH TEM)
	       (OUTPUSH TL)
	       (SETQ TL 0Q)])
	(SETSLOT TL (CONS (CAR LAMVARS) 'TAKEN))
	(SETQ LAMARGS (CDR LAMARGS))
	(SETQ LAMVARS (CDR LAMVARS))
	(GO A)
      B (COND [SF (OUTINST '(JSP 6Q SPECBIND))])
	(SETQ LAMVARS (CADR LAMXPR))
      C (COND [(NULL LAMVARS) (GO D)])
	(SETQ TL (ILOC (CONS (CAR LAMVARS) 'TAKEN) NIL))
	(COND [(SPECVARP (CAR LAMVARS))
	       (FREEZE (CAR LAMVARS))
	       (OUTINST (LIST 0Q TL (LIST 'SPECIAL (CAR LAMVARS)) 'S))])
	(RPLACD (SLOTCONT TL) NIL)
	(SETQ LAMVARS (CDR LAMVARS))
	(GO C)
      D (SETQ LAMVARS (CADR LAMXPR))
	(COND [EFFECTS (SETQ TEM (COMPE (CADDR LAMXPR)))]
	      [T (SETQ TEM (COMP (CADDR LAMXPR) VALAC))
		 (COND [(EQ (CAR TEM) 'QUOTE) (GO DD)] [T (SETQ TL (LOC TEM))])
		 (COND [(NOT (NUMBERP TL))
			(AND [EQ (CAR TL) 'SPECIAL] [NOT (MEMB (CADR TL) LAMVARS)] [GO DD])
			(LOADARG VALAC TEM)
			(SETQ TL VALAC)])
		 (COND [(MEMB (CAR (SLOTCONT TL)) LAMVARS)
			(REMOVL TEM)
			(SETQ TEM (MARKVAL TL EFFECTS))])])
     DD (COND [SF (OUTINST '(PUSHJ P SPECSTR))])
	(INCR P2CNT)
      E (COND [(NULL LAMVARS) (RETURN TEM)] [T (FREEZE (CAR LAMVARS))])
	(SETQ LAMVARS (CDR LAMVARS))
	(GO E)))
 EXPR)

(DEFPROP KILLPDL (LAMBDA NIL (RESTOR NIL)) EXPR)

(DEFPROP LAMBDABIND (LAMBDA (VARS) (BINDVARS VARS T)) EXPR)

(DEFPROP LISTNILS
 (LAMBDA (NUMBER)
  (PROG (LIST)
   LOOP (COND [(ZEROP NUMBER) (RETURN LIST)])
	(SETQ LIST (CONS NIL LIST))
	(SETQ NUMBER (SUB1 NUMBER))
	(GO LOOP)))
 EXPR)

(DEFPROP LOADARG
 (LAMBDA (ACNO VAR)
  (PROG (DATAORG OLDACC DATACONT DAC DOD)
	(REMOVL VAR)
	(SETQ DATAORG (ILOC1 VAR ACNO))
	(SETQ OLDACC (SLOTCONT ACNO))
	(SETQ DATACONT (COND [(NUMBERP DATAORG) (SLOTCONT DATAORG)]))
	(SETQ DAC (DVP OLDACC))
	(SETQ DOD (DVP DATACONT))
	(COND [(EQ ACNO DATAORG) (COND [DAC (CPUSH ACNO)]) (RETURN NIL)])
	(COND [(AND [EQ DATAORG 0Q]
		    [NOT DOD]
		    [NOT DAC]
		    [GREATERP (PDLDEPTH) MINDEPTH])
	       (GO POP)])
	(COND [(AND [NOT DOD]
		    [NOT (NULL OLDACC)]
		    [NUMBERP DATAORG]
		    [LESSP DATAORG ACNO])
	       (GO EXCH)])
	(COND [(NOT DAC) (GO FREE)])
	(GO PUSH)
   EXCH (SETSLOT DATAORG OLDACC)
	(SETSLOT ACNO DATACONT)
	(OUT1 'EXCH ACNO DATAORG)
	(RETURN NIL)
   PUSH (CPUSH ACNO)
	(SETQ DATAORG (LOC VAR))
   FREE (COND [(NOT (NUMBERP DATAORG)) (GO MOVE)])
	(SETSLOT ACNO 
		 (COND [(NULL (CDR DATACONT)) (CONS (CAR DATACONT) 'DUP)] [T DATACONT]))
	(OUTMOVE ACNO DATAORG)
	(RETURN NIL)
    POP (SETSLOT ACNO DATACONT)
	(OUTPOP ACNO)
	(RETURN NIL)
   MOVE (SETSLOT ACNO 
		 (COND [(EQ (CAAR DATAORG) 'QUOTE) (CAR DATAORG)] [T (LIST (CAR VAR))]))
	(OUTMOVE ACNO DATAORG)
	(RETURN NIL)))
 EXPR)

(DEFPROP LOADCARCDR
 (LAMBDA (ITEM AC)
  (PROG (ARG PATH ORIG)
	(COND [(EQ (ILOC1 (SETQ ARG (CDDR ITEM)) AC) AC) (REMOVL ARG)])
	(SETQ PATH (CSTEP (CADR ITEM) AC ARG))
	(COND [(NULL (CDR PATH))
	       (SETQ VARLIST (CONS (CONS (CAR (CAR PATH)) (CAR ITEM)) VARLIST))
	       (REMOVL ARG)
	       (RETURN (LOC (CAR PATH)))])
	(SETQ PATH (REVERSE PATH))
	(CPUSH AC)
	(SETQ ORIG (LOC (CAR PATH)))
	(SETQ PATH (CDR PATH))
	(REMOVL ARG)
     L1 (COND [(NULL PATH) (GO RET)])
	(COND [(NULL (CDR PATH)) (GO L2)])
	(COND [(AND [EQ AC VALUEAC] [EQ ORIG VALUEAC])
	       (OUTCALL 1Q (READLIST (CONS 'C (REVERSE (CONS 'R PATH)))))
	       (GO RET)])
     L2 (OUT1 (CADR (ASSOC (CAR PATH) '((A HLRZ@) (D HRRZ@)))) AC ORIG)
	(SETQ PATH (CDR PATH))
	(SETQ ORIG AC)
	(GO L1)
    RET (SETSLOT AC (LIST (CAR ITEM)))
	(RETURN AC)))
 EXPR)

(DEFPROP LOADCOMP (LAMBDA (XPR AC) (LOADARG AC (COMP XPR AC))) EXPR)

(DEFPROP LOADSUBRARGS
 (LAMBDA (ARGS)
  (PROG (ARGNO)
	(SETQ ARGNO (LENGTH ARGS))
   LOOP (COND [(NULL ARGS) (RETURN NIL)])
	(LOADARG ARGNO (CAR ARGS))
	(SETQ ARGS (CDR ARGS))
	(SETQ ARGNO (SUB1 ARGNO))
	(GO LOOP)))
 EXPR)

(DEFPROP LOC (LAMBDA (X) (ILOC1 X NIL)) EXPR)

(DEFPROP MARKVAL
 (LAMBDA (LOCATION EFFECTS)
  (PROG (VAR GVAL)
	(COND [(NULL LOCATION) (COMPERR NULLLOC-MARKVAL)])
	(SETQ GVAL (GENVAL))
	(SETQ VAR (CAR (SETSLOT LOCATION (LIST GVAL))))
	(COND [(NOT EFFECTS) (SETQ LDLST (CONS VAR LDLST))])
	(RETURN VAR)))
 EXPR)

(DEFPROP NONSPECVARS
 (LAMBDA (VRS)
  (PROG (ANS)
   LOOP (COND [(NULL VRS) (RETURN ANS)]
	      [(SPECVARP (CAR VRS))]
	      [T (SETQ ANS (CONS (CAR VRS) ANS))])
	(SETQ VRS (CDR VRS))
	(GO LOOP)))
 EXPR)

(DEFPROP OUT1 (LAMBDA (OP AC AD) (OUTINST (TRANSOUT OP AC AD))) EXPR)

(DEFPROP OUTCALL
 (LAMBDA (NUM FUN)
  (COND [(GET FUN 'NOCALL) (OUT1 'PUSHJ 'P FUN)]
	[T (OUTFUNCALL 'CALL NUM FUN)]))
 EXPR)

(DEFPROP OUTCALLF (LAMBDA (AC AD) (OUT1 'CALLF@ AC AD)) EXPR)

(DEFPROP OUTCJMP
 (LAMBDA (FLAG AC ADRESS)
  (OUTJMP (COND [FLAG 'JUMPN] [T 'JUMPE]) AC ADRESS))
 EXPR)

(DEFPROP OUTENDTAG
 (LAMBDA (X) (COND [(USEDTAGP X) (CLEARITALL) (RST X) (OUTTAG X)]))
 EXPR)

(DEFPROP OUTFUNCALL
 (LAMBDA (TYPE NUM FUN) (OUTINST (LIST TYPE NUM (LIST 'E FUN) 'S)))
 EXPR)

(DEFPROP OUTGOTAB
 (LAMBDA (X)
  (PROG (ETAG)
	(SETQ ETAG (GENTAG))
	(PUTPROP ETAG (TOPCOPY PDL) 'LEVEL)
	(COND [(NOT (EQ (CAAR LASTOUT) 'JRST)) (OUTJRST ETAG)])
	(OUTTAG (CAR X))
   LOOP (SETQ X (CDR X))
	(COND [(NULL X) (OUTINST '(PUSHJ P *UDT)) (OUTTAG ETAG) (RETURN NIL)])
	(OUTINST (LIST 'CAIN GOTABAC (LIST 'QUOTE (CAAR X)) 'S))
	(OUTJRST (CDAR X))
	(GO LOOP)))
 EXPR)

(DEFPROP OUTJCALL
 (LAMBDA (NUM FUN)
  (COND [(GET FUN 'NOCALL) (OUT1 'JRST 0Q FUN)]
	[T (OUTFUNCALL 'JCALL NUM FUN)]))
 EXPR)

(DEFPROP OUTJMP
 (LAMBDA (OP AC ADR)
  (PROG NIL
	(CLEAR1BOTH)
	(SAVEACS)
	(RST ADR)
	(PUTPROP ADR T 'USED)
	(OUTINST (LIST OP AC ADR))))
 EXPR)

(DEFPROP OUTJRST (LAMBDA (ADR) (OUTJMP 'JRST 0Q ADR)) EXPR)

(DEFPROP OUTMOVE (LAMBDA (AC MEM) (OUT1 'MOVE AC MEM)) EXPR)

(DEFPROP OUTMOVEM
 (LAMBDA (AC MEM)
  (COND [(AND [EQ MEM 0Q]
	      LASTOUT 
	      [EQ (CAAR LASTOUT) 'PUSH]
	      [EQ (CADAR LASTOUT) 'P])
	 (SETQ LASTOUT NIL)
	 (OUT1 'PUSH 'P AC)]
	[T (OUT1 'MOVEM AC MEM)]))
 EXPR)

(DEFPROP OUTPOP
 (LAMBDA (L)
  (PROG (L1)
	(SLOTPOP)
	(COND [(AND LASTOUT [EQ (CAAR LASTOUT) 'PUSH] [EQ (CADAR LASTOUT) 'P])
	       (SETQ L1 (CADDAR LASTOUT))
	       (COND [(EQUAL L1 L) (RETURN (SETQ LASTOUT NIL))]
		     [(ACNUMP L) (SETQ LASTOUT NIL) (RETURN (OUTMOVE L L1))])])
	(RETURN (OUT1 'POP 'P L))))
 EXPR)

(DEFPROP OUTPUSH
 (LAMBDA (L)
  (COND [(AND LASTOUT 
	      [EQ (CAAR LASTOUT) 'POP]
	      [ACNUMP L]
	      [EQUAL (CDDAR LASTOUT) (LIST 'P L)])
	 (SETQ LASTOUT NIL)
	 (OUTMOVE L 0Q)]
	[T (OUT1 'PUSH 'P L)]))
 EXPR)

(DEFPROP OUTPUTSTAT
 (LAMBDA (ST)
  (PROG (ADD)
	(COND [(ATOM ST) (GO PRINT)])
	(COND [(EQ (CAR ST) 'LAP) (GO PRINT)])
	(SETQ CODESIZE (ADD1 CODESIZE))
	(SETQ ADD (CADDR ST))
	(COND [(AND [NOT (ATOM ADD)] [EQ (CAR ADD) 'C]) (SETQ CONSTSIZE (ADD1 CONSTSIZE))])
  PRINT (PRINTSTAT ST)))
 EXPR)

(DEFPROP OUTSTAT
 (LAMBDA (ST)
  (PROG NIL
	(COND [(NULL LASTOUT) (GO SETIT)])
	(OUTPUTSTAT (CAR LASTOUT))
	(MAPC (FUNCTION (LAMBDA (X) (TERPRI) (TAB 22Q) (PRINA X 23Q)))
	      (CDR LASTOUT))
  SETIT (SETQ LASTOUT (CONS ST (LAPNOTES)))
	(RETURN NIL)))
 EXPR)

(DEFPROP PASS2
 (LAMBDA (X)
  (PROG	(ACS PDL PDLDEPTH MINDEPTH LDLST SPLDLST SPECFLAG PRGSPFLG CCLST VARLIST PROGVARS PROGSW
	     GOLIST)
	(SETQ P2CNT 1Q)
	(SETQ ACS (LISTNILS NACS))
	(SETQ ALLACS (SUB1 (LSH 1Q NACS)))
	(SETQ PDL NIL)
	(SETQ PDLDEPTH (LENGTH PDL))
	(SETQ MINDEPTH (PDLDEPTH))
	(SETQ SPECFLAG (LAMBDABIND (CADR X)))
	(COND [(NOT (EQ (CAADDR X) 'PROG)) (SETQ PRGSPFLG NIL)])
	(LOADCOMP (CADDR X) VALUEAC)
	(EXITBUM SPECFLAG)
	(OUTINST (OUTINST NIL))
	(COND [LDLST (COMPERR LDLSTLEFT-PASS2)])
	(RETURN NIL)))
 EXPR)

(DEFPROP P2*EVAL
 (LAMBDA (XPR VALAC EFFECTS)
  (PROG (ARG TEM)
	(SETQ ARG (CADR XPR))
	(COND [(AND [EQ (CAR ARG) 'CONS]
		    [EQ (CAADR ARG) 'QUOTE]
		    [GETL (SETQ TEM (CADADR ARG)) '(FEXPR FSUBR *FSUBR)])
	       (GO NOCONS)])
	(RETURN (CALLSUBR XPR VALAC EFFECTS))
 NOCONS (LOADCOMP (CADDR ARG) FARGAC)
	(CLEAR2BOTH)
	(PROTECTACS TEM)
	(OUTCALL 17Q TEM)
	(RETURN (MARKVAL VALUEAC EFFECTS))))
 EXPR)

(DEFPROP P2ARG
 (LAMBDA (XPR VALAC EFFECTS)
  (PROG (ARG)
	(COND [(NOT INLSUBR) (USERERR NOTINLSUBR-P2ARG)])
	(SETQ ARG (COMP (CADR XPR) VALAC))
	(COND [(EQ (CAR ARG) 'QUOTE)
	       (CPUSH VALAC)
	       (OUTMOVE VALAC (MINUS (ADD1 (PDLDEPTH))))
	       (OUTINST (LIST 'HRRZ VALAC (CADR ARG) VALAC))
	       (RETURN (MARKVAL VALAC EFFECTS))])
	(LOADARG VALAC ARG)
	(OUT1 'ADD VALAC (MINUS (ADD1 (PDLDEPTH))))
	(OUTINST (LIST 'HRRZ VALAC (MINUS INUM0) VALAC))
	(RETURN (MARKVAL VALAC EFFECTS))))
 EXPR)

(DEFPROP P2CARCDR
 (LAMBDA (XPR VALAC EFFECTS)
  (PROG (TEM)
	(COND [(NOT (EQ (LENGTH (CDR XPR)) 1Q)) (USERERR ARGNOERR-P2CARCDR)])
	(COND [EFFECTS (RETURN (COMPE (CADR XPR)))])
	(SETQ XPR
	      (CONS (SETQ TEM (GENSYM)) (CONS (CAR XPR) (COMP (CADR XPR) VALAC))))
	(PUTPROP TEM VALAC 'CCAC)
	(SETQ CCLST (CONS XPR CCLST))
	(SETQ TEM (CONS TEM P2CNT))
	(SETQ LDLST (CONS TEM LDLST))
	(RETURN TEM)))
 EXPR)

(DEFPROP P2COND
 (LAMBDA (XPR VALAC EFFECTS)
  (PROG NIL
	(P2COND1 (CDR XPR) VALAC EFFECTS NIL NIL)
	(INCR P2CNT)
	(INCR P2CNT)
	(CPUSH VALAC)
	(RETURN (MARKVAL VALAC EFFECTS))))
 EXPR)

(DEFPROP P2COND1
 (LAMBDA (EXP VALAC EFFECTS BOOLFLG BOOLTAG)
  (PROG (LDL VARLOC LOCCONT)
	(SETQ LDL LDLST)
    CHK (COND [(NULL LDL) (GO OK)] [(ASSOC (CAAR LDL) LOCVARS) (GO ISVAR)])
   ECHK (SETQ LDL (CDR LDL))
	(GO CHK)
  ISVAR (COND [(NOT (NUMBERP (SETQ VARLOC (LOC (CAR LDL)))))]
	      [(NOT (DVP (SETQ LOCCONT (SLOTCONT VARLOC))))
	       (SETSLOT VARLOC (CONS (CAAR LDL) P2CNT))
	       (GO ECHK)]
	      [(NUMBERP (CDR LOCCONT)) (GO ECHK)])
	(SLOTPUSH (CONS (CAAR LDL) P2CNT))
	(OUTPUSH VARLOC)
	(GO ECHK)
     OK (CLEAR1)
	(INCR P2CNT))
  (PROG (MINDEPTH CTAG RSL CONDEXIT PAIREXIT H1 H2 RETNIL IRSSL ACNIL PAIR ATAG REST)
	(SETQ CONDEXIT (GENTAG))
	(SETQ IRSSL (TOPCOPY PDL))
	(SETQ MINDEPTH (PDLDEPTH))
	(PUTPROP CONDEXIT IRSSL 'LEVEL)
   LOOP (SETQ RSL NIL)
	(COND [(NULL EXP)
	       (COND [RETNIL (LOADARG VALAC ''NIL)])
	       (OUTENDTAG CONDEXIT)
	       (COND [(OR [USEDTAGP PAIREXIT] BOOLTAG) (CLEARITALL)])
	       (RESTOR IRSSL)
	       (RETURN NIL)])
	(SETQ PAIR (CAR EXP))
	(COND [(NULL (CDR PAIR))
	       (COND [(NULL (CDR EXP))
		      (COND [EFFECTS (COMPE (CAR PAIR))]
			    [BOOLTAG (BOOLEXPR (CAR PAIR) VALAC BOOLTAG BOOLFLG MINDEPTH)]
			    [T (LOADCOMP (CAR PAIR) VALAC)])]
		     [(OR EFFECTS [AND BOOLTAG [NULL BOOLFLG]])
		      (BOOLEXPR (CAR PAIR) VALAC CONDEXIT T MINDEPTH)]
		     [BOOLTAG (BOOLEXPR (CAR PAIR) VALAC BOOLTAG T MINDEPTH)]
		     [T (LOADCOMP (CAR PAIR) VALAC) (OUTCJMP T VALAC CONDEXIT)])
	       (RESTOR IRSSL)
	       (GO NONIL)])
	(COND [BOOLTAG (GO L2)])
	(COND [(AND [EQUAL (CDR PAIR) '('NIL)]
		    [EQ (CAAR PAIR) 'NULL]
		    [OR [ATOM (CADAR PAIR)] [NOT (HASPROP (CAADAR PAIR) 'BOOL)]])
	       (LOADCOMP (CADAR PAIR) VALAC)
	       (OUTCJMP NIL VALAC CONDEXIT)
	       (SETQ RETNIL T)
	       (GO ELOOP)])
	(COND [(OR LDLST [NOT (NULL (CDDR PAIR))]) (GO L2)])
	(COND [(AND [EQ (CAADR PAIR) 'GO] [ATOM (SETQ ATAG (CADADR PAIR))])
	       (BOOLEXPR (CAR PAIR) VALAC (EQUIVTAG ATAG) T MINDEPTH)
	       (GO NONIL)])
	(COND [(EQUAL (CADR PAIR) '(RETURN 'NIL))
	       (BOOLEXPR (CAR PAIR) VALAC EXITN T MINDEPTH)
	       (GO NONIL)])
     L2 (SETQ PAIREXIT (SETQ CTAG (GENTAG)))
	(PUTPROP PAIREXIT IRSSL 'LEVEL)
	(SETQ RSL NIL)
	(BOOLEXPR (CAR PAIR)
		  VALAC 
		  (COND [(AND BOOLTAG [NULL (CDR EXP)] [NULL BOOLFLG]) BOOLTAG]
			[T PAIREXIT])
		  NIL 
		  MINDEPTH)
	(SETQ H2
	      (COND [(NOT (ATOM RSL)) RSL]
		    [T (LIST (TOPCOPY ACS) (TOPCOPY PDL) (PDLDEPTH))]))
	(SETQ H1 (LIST (TOPCOPY SPLDLST) (TOPCOPY CCLST)))
	(SETQ REST (CDR PAIR))
    LP1 (COND [(NULL (CDR REST)) (GO L1)])
	(COMPE (CAR REST))
	(SETQ REST (CDR REST))
	(GO LP1)
     L1 (COND [EFFECTS (COMPE (CAR REST))]
	      [BOOLTAG (BOOLEXPR (CAR REST) VALAC BOOLTAG BOOLFLG MINDEPTH)]
	      [T (LOADCOMP (CAR REST) VALAC)])
	(SAVEACS)
	(SETQ SPLDLST (CAR H1))
	(SETQ CCLST (CADR H1))
	(SETQ H1 ACS)
	(SETQ ACS (CAR H2))
	(SETQ ACNIL (EQUAL (SLOTCONT VALAC) ''NIL))
	(SETQ ACS H1)
	(SETQ RETNIL NIL)
	(COND [(NOT (MEMQ (CAAR REST) '(GO RETURN)))
	       (COND [(OR [NOT (NULL (CDR EXP))]
			  [AND [NOT EFFECTS]
			       [NOT BOOLTAG]
			       [NOT ACNIL]
			       [SETQ RETNIL (USEDTAGP PAIREXIT)]])
		      (OUTJRST CONDEXIT)]
		     [T (RESTOR IRSSL)])])
	(SETQ ACS (CAR H2))
	(SETQ PDL (CADR H2))
	(SETQ PDLDEPTH (CADDR H2))
	(COND [(USEDTAGP PAIREXIT) (OUTTAG PAIREXIT)])
	(GO ELOOP)
  NONIL (SETQ RETNIL NIL)
  ELOOP (SETQ EXP (CDR EXP))
	(GO LOOP)))
 EXPR)

(DEFPROP P2ELSE
 (LAMBDA (XPR VALAC EFFECTS) (COMPERR SOMETHINGELSE-P2ELSE))
 EXPR)

(DEFPROP P2EQ
 (LAMBDA (XPR VALAC EFFECTS)
  (PROG NIL
	(COND [EFFECTS (COMPE (CADR XPR)) (COMPE (CADDR XPR)) (RETURN NIL)])
	(BOOLEQ1 (CDR XPR) VALAC NIL NIL)
	(RETURN (BOOLVALUE VALAC EFFECTS NIL))))
 EXPR)

(DEFPROP P2GO
 (LAMBDA (XPR VALAC EFFECTS)
  (PROG (TAG)
	(SETQ TAG (CADR XPR))
	(SAVEACS)
	(CLRPVARS)
	(COND [(ATOM TAG) (OUTJRST (EQUIVTAG TAG))]
	      [T (LOADARG GOTABAC (COMP TAG VALAC)) (OUTJRST VGO)])
	(RETURN (MARKVAL VALUEAC EFFECTS))))
 EXPR)

(DEFPROP P2NULL
 (LAMBDA (XPR VALAC EFFECTS)
  (PROG (CTAG RSL G)
	(CLEAR2BOTH)
	(PUTPROP (SETQ G (GENTAG)) T 'SET)
	(BOOLEXPR XPR VALAC G T MINDEPTH)
	(RETURN (BOOLVALUE VALAC EFFECTS G))))
 EXPR)

(DEFPROP P2PROG
 (LAMBDA (XPR VALAC EFFECTS)
  (PROG (PSFLG)
	(SETQ PSFLG (PROGBIND (CADDR XPR)))
	(SETQ PRGSPFLG NIL)
	(CLEAR1)
	(P2PROG1 XPR VALAC EFFECTS MINDEPTH)
	(COND [PSFLG (OUTINST '(PUSHJ P SPECSTR))])
	(CPUSH VALAC)
	(RETURN (MARKVAL VALAC EFFECTS))))
 EXPR)

(DEFPROP P2PROG1
 (LAMBDA (XPR VALAC EFFECTS MINDEPTH)
  (PROG (GOLIST EXIT EXITN PVR PRSSL PROGSW VGO)
	(INCR P2CNT)
	(SETQ PROGSW T)
	(SETQ PVR (COND [EFFECTS NIL] [T VALAC]))
	(SETQ EXIT (GENTAG))
	(SETQ EXITN (GENTAG))
	(SETQ VGO (GENTAG))
	(SETQ GOLIST
	      (CONS (CONS NIL EXIT)
		    (CONS (CONS NIL EXITN) (CONS (CONS NIL VGO) (CADR XPR)))))
	(SETQ PROGVARS (NONSPECVARS (CADDR XPR)))
	(SETQ XPR (CDDDR XPR))
   LOOP (COND [(NULL XPR) (GO EXITN)])
	(INCR P2CNT)
	(COND [(NOT PROGSW) (RESTOR PRSSL)])
	(COND [(TAGP (CAR XPR)) (PROGTAG (CAR XPR))]
	      [(AND [NULL (CDR XPR)] [EQ (CAAR XPR) 'RETURN])
	       (COND [(EQUAL (CDAR XPR) '('NIL)) (GO EXITN)]
		     [EFFECTS (COMPE (CADAR XPR))]
		     [T (LOADCOMP (CADAR XPR) VALAC)])
	       (COND [(USEDTAGP EXITN) (OUTJRST EXIT) (GO EXITN)] [T (GO EXIT)])]
	      [T (COMPE (CAR XPR))])
	(SETQ XPR (CDR XPR))
	(GO LOOP)
  EXITN (OUTENDTAG EXITN)
	(COND [(AND [NOT EFFECTS] [NOT (EQ (CAAR LASTOUT) 'JRST)])
	       (LOADARG PVR ''NIL)])
   EXIT (OUTENDTAG EXIT)
	(INCR P2CNT)
	(INCR P2CNT)
	(COND [(USEDTAGP VGO) (OUTGOTAB (CONS VGO (CDDDR GOLIST)))])
	(RETURN NIL)))
 EXPR)

(DEFPROP P2PROG2
 (LAMBDA (XPR VALAC EFFECTS)
  (PROG (ARGS ARG2)
	(SETQ ARGS (CDR XPR))
	(COND [(LESSP (LENGTH ARGS) 2Q) (USERERR TOOFEWARGS-P2PROG2)])
	(COMPE (CAR ARGS))
	(SETQ ARG2
	      (COND [(NOT EFFECTS) (COMP (CADR ARGS) VALAC)]
		    [T (COMPE (CADR ARGS))]))
	(SETQ ARGS (CDDR ARGS))
   LOOP (COND [(NULL ARGS) (RETURN ARG2)])
	(COMPE (CAR ARGS))
	(SETQ ARGS (CDR ARGS))
	(GO LOOP)))
 EXPR)

(DEFPROP P2QUOTE (LAMBDA (XPR VALAC EFFECTS) XPR) EXPR)

(DEFPROP P2RETURN
 (LAMBDA (XPR VALAC EFFECTS)
  (PROG (VAL)
	(SETQ VAL (CADR XPR))
	(SAVEACS)
	(CLRPVARS)
	(COND [(EQUAL VAL ''NIL) (OUTJRST EXITN) (GO DONE)]
	      [(NULL PVR) (COMPE VAL)]
	      [T (LOADCOMP VAL PVR)])
	(OUTJRST EXIT)
   DONE (RETURN (MARKVAL VALAC EFFECTS))))
 EXPR)

(DEFPROP P2RPLAC
 (LAMBDA (XPR VALAC EFFECTS)
  (PROG (ARG1 ARG2)
	(SETQ ARG1 (COMP (CADR XPR) VALAC))
	(SETQ ARG2 (COMP (CADDR XPR) (FREEAC)))
	(ILOC1 ARG1 VALAC)
	(LOC ARG2)
	(REMOVS ARG1)
	(REMOVS ARG2)
	(CLEAR2BOTH)
	(COND [(EQUAL ARG2 ''NIL)
	       (OUT1 (CADR (ASSOC (CAR XPR) '((RPLACA HRRZS@) (RPLACD HLLZS@))))
		     0Q 
		     (LOC ARG1))]
	      [T (OUT1 (CADR (ASSOC (CAR XPR) '((RPLACA HRLM@) (RPLACD HRRM@))))
		       (PUTINAC ARG2 (FREEAC))
		       (LOC ARG1))])
	(REMOVL ARG2)
	(RETURN ARG1)))
 EXPR)

(DEFPROP P2SETARG
 (LAMBDA (XPR VALAC EFFECTS)
  (PROG (ARG AC)
	(COND [(NOT INLSUBR) (USERERR NOTINLSUBR-P2SETARG)])
	(SETQ ARG (COMP (CADDR XPR) VALAC))
	(CLEARAC (SETQ AC (COND [(EQ VALAC 5Q) 4Q] [T 5Q])))
	(COND [(EQ (CAADR XPR) 'QUOTE)
	       (LOADARG VALAC ARG)
	       (OUT1 'MOVE AC (MINUS (ADD1 (PDLDEPTH))))
	       (OUTINST (LIST 'HRRM VALAC (CADADR XPR) AC))
	       (RETURN ARG)])
	(LOADCOMP (CADR XPR) AC)
	(LOADARG VALAC ARG)
	(OUT1 'ADD AC (MINUS (ADD1 (PDLDEPTH))))
	(OUTINST (LIST 'HRRM VALAC (MINUS INUM0) AC))
	(RETURN ARG)))
 EXPR)

(DEFPROP P2SETQ
 (LAMBDA (XPR VALAC EFFECTS)
  (PROG (NVAR VALLOC HOME VAR VAL TEM)
	(SETQ VAR (CADR XPR))
	(MAPC (FUNCTION
	       (LAMBDA (X) (COND [(EQ VAR (CADDR X)) (CSFUN X) (REMLST X 'CCLST)])))
	      CCLST)
	(AND EFFECTS [SETQ VALAC (FREEAC)])
	(SETQ VAL (COMP (CADDR XPR) VALAC))
	(SETQ VALLOC (LOC VAL))
	(COND [(ASSOC VAR SPLDLST) (CLRSPVAR VAR) (REMSPVAR VAR)]
	      [T (SETQ PROGVARS (DREMOVE VAR PROGVARS))])
	(REMOVL VAL)
	(FREEZE VAR)
	(SETQ HOME
	      (COND [(SPECVARP VAR) T]
		    [(NOT (ILOC (SETQ NVAR (CONS VAR P2CNT)) VALAC)) NIL]
		    [T (NOT (DVP (SLOTCONT (LOC NVAR))))]))
	(INCR P2CNT)
	(COND [(AND EFFECTS [NOT HOME])
	       (COND [(AND [NUMBERP VALLOC] [NOT (DVP (SLOTCONT VALLOC))])
		      (SETSLOT VALLOC (LIST VAR))
		      (GO EXIT)]
		     [T (SLOTPUSH (LIST VAR)) (OUTPUSH VALLOC) (GO EXIT)])])
	(COND [(AND HOME [EQUAL VAL ''NIL])
	       (SETQ TEM T)
	       (OUT1 (COND [(OR EFFECTS [DVP (SLOTCONT VALAC)]) (SETQ TEM NIL) 'CLEARM]
			   [T 'CLEARB])
		     VALAC 
		     (SETQ VAL
			   (COND [(SPECVARP VAR) (LIST 'SPECIAL VAR)]
				 [T (ILOC (CONS VAR (SUB1 P2CNT)) VALAC)])))
	       (COND [(NUMBERP VAL) (SETSLOT VAL (LIST VAR))])
	       (COND [TEM (SETSLOT VALAC (CONS VAR (COND [(NUMBERP VAL) 'DUP] [T NIL])))])
	       (GO EXIT)])
	(COND [(OR [NOT (NUMBERP VALLOC)]
		   [LESSP VALLOC 0Q]
		   [DVP (SLOTCONT VALLOC)])
	       (LOADARG VALAC VAL)
	       (SETQ VALLOC VALAC)])
	(SETSLOT VALLOC (LIST VAR))
	(COND [(SPECVARP VAR)
	       (COND [(ZEROP VALLOC) (OUTPOP (LIST 'SPECIAL VAR))]
		     [T (OUTMOVEM VALLOC (LIST 'SPECIAL VAR))])])
   EXIT (RETURN (COMP VAR VALAC))))
 EXPR)

(DEFPROP P2STORE
 (LAMBDA (XPR VALAC EFFECTS)
  (PROG (TEM)
	(LOC (SETQ TEM (COMP (CADDR XPR) VALAC)))
	(COMPE (CADR XPR))
	(LOADARG ARRAYAC TEM)
	(OUTINST '(PUSHJ P NSTR))
	(RETURN TEM)))
 EXPR)

(DEFPROP PROGBIND (LAMBDA (VARS) (BINDVARS VARS NIL)) EXPR)

(DEFPROP PROGTAG
 (LAMBDA (TAG)
  (PROG NIL
	(CLEAR2BOTH)
	(CLEARACS)
	(CLRPVARS)
	(RESTOR PRSSL)
	(OUTTAG (EQUIVTAG TAG))))
 EXPR)

(DEFPROP PROTECTACS
 (LAMBDA (X)
  (PROG (WHICHACS ACNO)
	(SETQ WHICHACS (ACEFFECTS X))
	(SETQ ACNO 0Q)
   LOOP (SETQ ACNO (ADD1 ACNO))
	(COND [(ZEROP WHICHACS) (RETURN NIL)]
	      [(NOT (ZEROP (BOOLE 1Q 1Q WHICHACS))) (CLEARAC ACNO)])
	(SETQ WHICHACS (LSH WHICHACS -1Q))
	(GO LOOP)))
 EXPR)

(DEFPROP PUTINAC
 (LAMBDA (X AC)
  (PROG (Z)
	(SETQ Z (LOC X))
	(COND [(NOT (ACNUMP Z)) (LOADARG (SETQ Z AC) X)])
	(REMOVL X)
	(CPUSH Z)
	(RETURN Z)))
 EXPR)

(DEFPROP REMOVL
 (LAMBDA (DATA) (PROG NIL (REMLST DATA 'LDLST) (REMLST DATA 'SPLDLST)))
 EXPR)

(DEFPROP REMLST
 (LAMBDA (DATA LST)
  (PROG (TEM)
	(SETQ TEM (GETPROP LST 'VALUE))
   LOOP (COND [(NULL (CDR TEM)) (RETURN NIL)])
	(COND [(EQUAL (CADR TEM) DATA) (RPLACD TEM (CDDR TEM))]
	      [T (SETQ TEM (CDR TEM))])
	(GO LOOP)))
 EXPR)

(DEFPROP REMOVS (LAMBDA (DATA) (REMLST DATA 'SPLDLST)) EXPR)

(DEFPROP REMSPVAR
 (LAMBDA (SPV)
  (PROG (SPL)
	(SETQ SPL (GETPROP 'SPLDLST 'VALUE))
   BACK (COND [(NULL (CDR SPL)) (RETURN NIL)])
	(COND [(EQ SPV (CAADR SPL)) (RPLACD SPL (CDDR SPL))]
	      [T (SETQ SPL (CDR SPL))])
	(GO BACK)))
 EXPR)

(DEFPROP RESTOR
 (LAMBDA (OLDPDL)
  (PROG (C V R TEM OLDDEPTH DEPTHDIF)
	(SETQ OLDDEPTH (LENGTH OLDPDL))
	(COND [(GREATERP OLDDEPTH (PDLDEPTH))
	       (PRINTMSG (LIST OLDPDL PDL))
	       (COMPERR PDLSHORT-RESTOR)])
     A1 (SETQ C 0Q)
      A (COND [(EQUAL OLDDEPTH (PDLDEPTH)) (RETURN (SHRINKPDL C))]
	      [(DVP (SETQ R (CAR PDL))) (GO CPP)])
	(SETQ C (ADD1 C))
	(SLOTPOP)
	(GO A)
    CPP (SHRINKPDL C)
   CPP1 (SETQ V OLDPDL)
	(SETQ C 0Q)
	(SETQ DEPTHDIF (*DIF (PDLDEPTH) OLDDEPTH))
   CPP3 (COND [(NULL V)
	       (SETQ V (FINDFREEAC))
	       (COND [(NULL V) (COMPERR NOAC-RESTOR)])
	       (SETSLOT V R)
	       (OUTPOP V)
	       (GO A1)]
	      [(AND [CAR V]
		    [EQ (CAAR V) (CAR R)]
		    [NOT (DVP (SLOTCONT (SETQ TEM (MINUS (PLUS C DEPTHDIF)))))])
	       (GO CPP2)])
	(SETQ C (ADD1 C))
	(SETQ V (CDR V))
	(GO CPP3)
   CPP2 (SETSLOT TEM R)
	(OUTPOP TEM)
	(GO A1)))
 EXPR)

(DEFPROP RSLSET
 (LAMBDA (X)
  (COND [(EQ X CTAG)
	 (SETQ RSL
	       (COND [(AND RSL [NOT (AND [EQUAL (CAR RSL) ACS] [EQUAL (CADR RSL) PDL])])
		      'LOSE]
		     [T (LIST (TOPCOPY ACS) (TOPCOPY PDL) (PDLDEPTH))]))]))
 EXPR)

(DEFPROP RST
 (LAMBDA (TAG)
  (COND [(NULL TAG) NIL]
	[(ASSOCR TAG GOLIST) (RESTOR PRSSL)]
	[(REMPROP TAG 'SET)
	 (SAVEACS)
	 (PUTPROP TAG (TOPCOPY PDL) 'LEVEL)
	 (SETQ MINDEPTH (PDLDEPTH))]
	[(SETQ TAG (SEEKPROP TAG 'LEVEL)) (RESTOR (PROPVAL TAG))]
	[T (COMPERR NIL-RST)]))
 EXPR)

(DEFPROP SAVEACS
 (LAMBDA NIL
  (PROG (K)
	(SETQ K 0Q)
   LOOP (COND [(EQ K NACS) (RETURN NIL)])
	(CPUSH (SETQ K (ADD1 K)))
	(GO LOOP)))
 EXPR)

(DEFPROP SETSLOT (LAMBDA (X Y) (RPLACA (GETSLOT X) Y)) EXPR)

(DEFPROP SHRINKPDL
 (LAMBDA (C)
  (COND [(NOT (ZEROP C))
	 (AND LASTOUT 
	      [EQ (CAAR LASTOUT) 'SUB]
	      [EQ (CADAR LASTOUT) 'P]
	      [SETQ C (*PLUS C (CADR (CADDAR LASTOUT)))]
	      [SETQ LASTOUT NIL])
	 (OUTINST (LIST 'SUB 'P (GENCONST C 0Q C 0Q)))]))
 EXPR)

(DEFPROP SIDEEFFECTS (LAMBDA (FUN) (NOT (HASPROP FUN 'ACS))) EXPR)

(DEFPROP SLOTCONT (LAMBDA (X) (CAR (GETSLOT X))) EXPR)

(DEFPROP SLOTLIST (LAMBDA NIL (APPEND ACS PDL)) EXPR)

(DEFPROP SLOTPOP
 (LAMBDA NIL
  (PROGN (SETQ PDLDEPTH (SUB1 PDLDEPTH)) (SETQ PDL (CDR PDL))))
 EXPR)

(DEFPROP SLOTPUSH
 (LAMBDA (SC)
  (PROGN (SETQ PDLDEPTH (ADD1 PDLDEPTH)) (SETQ PDL (CONS SC PDL))))
 EXPR)

(DEFPROP SPECVARP (LAMBDA (VAR) (MEMBER VAR SPECVARS)) EXPR)

(DEFPROP TRANSOUT
 (LAMBDA (OP AC AD)
  (PROG (TEM IND)
	(COND [(OR [ATOM AD] [ATOM (CAR AD)]) (GO DONE)])
	(SETQ AD (CAR AD))
	(COND [(SETQ TEM (SEEKPROP OP 'IMMED)) (SETQ OP (PROPVAL TEM)) (GO DONE)])
	(SETQ AD (GENCONST 0Q 0Q AD 0Q))
   DONE (SETQ IND
	      (COND [(NEEDS AD) (LIST 'S)]
		    [(OR [NOT (NUMBERP AD)] [GREATERP AD 0Q]) NIL]
		    [T (LIST 'P)]))
	(RETURN (MCONS OP AC AD IND))))
 EXPR)

(DEFPROP USEDTAGP (LAMBDA (TAG) (HASPROP TAG 'USED)) EXPR)

(DEFLIST ((EXPR CALLSUBR)
	  (SUBR CALLSUBR)
	  (*SUBR CALLSUBR)
	  (*UNDEF CALLSUBR)
	  (LSUBR CALLLSUBR)
	  (*LSUBR CALLLSUBR)
	  (FEXPR CALLFSUBR)
	  (FSUBR CALLFSUBR)
	  (*FSUBR CALLFSUBR)
	  (FUNVAR CALLFUNARGS)
	  (CARCDR P2CARCDR)
	  (P2 DOP2))
	 PASS2)

(DEFLIST ((ARG P2ARG)
	  (*EVAL P2*EVAL)
	  (COND P2COND)
	  (EQ P2EQ)
	  (GO P2GO)
	  (NULL P2NULL)
	  'P2QUOTE
	  (PROG P2PROG)
	  (PROG2 P2PROG2)
	  (RETURN P2RETURN)
	  (RPLACA P2RPLAC)
	  (RPLACD P2RPLAC)
	  (SETARG P2SETARG)
	  (SETQ P2SETQ)
	  (STORE P2STORE))
	 P2)

(DEFLIST ((EQ BOOLEQ) (NULL BOOLNULL) 'BOOLQUOTE (COND BOOLCOND)) BOOL)

(DEFLIST ((ASSOC 3Q)
	  (ATOM 1Q)
	  (CHRCT 1Q)
	  (CHRPOS 1Q)
	  (CLRBFI 1Q)
	  (CONS 3Q)
	  (CONSP 3Q)
	  (FREE 1Q)
	  (FREELIST 3Q)
	  (GENSYM 7Q)
	  (GET 1Q)
	  (LAST 3Q)
	  (LENGTH 7Q)
	  (LITATOM 3Q)
	  (MEMB 7Q)
	  (MEMQ 7Q)
	  (NCONS 3Q)
	  (NUMBERP 3Q)
	  (*NCONC 7Q)
	  (PATOM 1Q)
	  (PROMPT 1Q)
	  (READP 1Q)
	  (REVERSE 3Q)
	  (REMPROP 3Q)
	  (STRINGP 3Q)
	  (TALK 1Q)
	  (UNTYI 3Q)
	  (XCONS 3Q))
	 ACS)

(DEFLIST ((CONS XCONS)
	  (EQUAL EQUAL)
	  (*GREAT *LESS)
	  (*LESS *GREAT)
	  (*PLUS *PLUS)
	  (*TIMES *TIMES)
	  (*MIN *MIN)
	  (*MAX *MAX)
	  (+ +)
	  (* *)
	  (= =)
	  (LT GT)
	  (GT LT)
	  (LE GE)
	  (GE LE))
	 COMMU)

(DEFLIST ((CAME CAIE)
	  (CAMN CAIN)
	  (HLLZS@ HLLZS)
	  (HLRZ@ HLRZ)
	  (HRLM@ HRLM)
	  (HRRM@ HRRM)
	  (HRRZ@ HRRZ)
	  (HRRZS@ HRRZS)
	  (MOVE MOVEI))
	 IMMED)

(DEFV CARCDRDEPTH 4Q)

(PROGN
(DEFPROP SETUPCARCDRS
 (LAMBDA NIL
  (PROG (BASE COUNT LIMIT MIDDLE NAME)
	(SETQ BASE 2Q)
	(SETQ LIMIT (SUB1 (LSH 1Q (ADD1 CARCDRDEPTH))))
	(SETQ COUNT (LSH 1Q 1Q))
   LOOP (COND [(GREATERP COUNT LIMIT) (RETURN NIL)])
	(SETQ MIDDLE (SUBST 'A '/0 (SUBST 'D '/1 (CDR (EXPLODE COUNT)))))
	(SETQ NAME (READLIST (APPEND '(C) MIDDLE '(R))))
	(PUTPROP NAME 
		 (CONS (CAR MIDDLE)
		       (COND [(CDR MIDDLE) (READLIST (APPEND '(C) (CDR MIDDLE) '(R)))]))
		 'CARCDR)
	(PUTPROP NAME 1Q 'ACS)
	(SETQ COUNT (ADD1 COUNT))
	(GO LOOP)))
 EXPR)
)

(SETUPCARCDRS)

(DEFV NACS 5Q)

(DEFV VALUEAC 1Q)

(DEFV FARGAC 1Q)

(DEFV GOTABAC 1Q)

(DEFV ARRAYAC 1Q)

(SETQ INUM0 (MAKNUM 0Q 'FIXNUM))

{;; Debugging Functions:⎇

(DEFPROP CMPBREAK
 (LAMBDA (TYPE MESSAGE)
  (TALK)
  (OUTC (PROG1 (OUTC NIL NIL) (PRINTLEV DEBUGXPR 2Q)) NIL)
  (ERROR (LIST (APPEND TYPE MESSAGE))))
 EXPR)

(DEFPROP COMPERR (LAMBDA (L) (CMPBREAK '(*COMPILER ERROR*) L)) FEXPR)

(DEFPROP LAPNOTES
 (LAMBDA NIL (COPY (MAPCAR (FUNCTION EVAL) TRACELIST)))
 EXPR)

(DEFPROP USERERR (LAMBDA (L) (CMPBREAK '(*USER ERROR*) L)) FEXPR)

(DEFV TRACELIST NIL)

{;; IO Functions:⎇

(DEFPROP ATMARGIN (LAMBDA NIL (EQ (CHRCT) (LINELENGTH NIL))) EXPR)

(DEFPROP CARRETN (LAMBDA NIL (COND [(NOT (ATMARGIN)) (LINEF 1Q)])) EXPR)

(DEFPROP LINEF
 (LAMBDA (N)
  (PROG NIL
   LOOP (COND [(ZEROP N) (RETURN NIL)])
	(TERPRI)
	(SETQ N (SUB1 N))
	(GO LOOP)))
 EXPR)

(DEFPROP MAPPRINS (LAMBDA (L) (MAPC (FUNCTION PRINS) L)) EXPR)

(DEFPROP PRINS
 (LAMBDA (FN)
  (PROG2 (COND [(GREATERP (ADD1 (FLATSIZE FN)) (CHRCT)) (LINEF 1Q)])
	 (PRINTEXPR FN)))
 EXPR)

(DEFPROP PRINTEXPR (LAMBDA (XPR) (PROG2 (PRIN1 XPR) (PRINC '" "))) EXPR)

(DEFPROP PRINTSTAT
 (LAMBDA (STAT)
  (PROG2 (COND [(NULL STAT) (CARRETN) (TAB 11Q)]
	       [(ATOM STAT) (TAB 2Q)]
	       [(EQ (CAR STAT) 'LAP) (TAB 1Q)]
	       [T (TAB 11Q)])
	 (PRIN1 STAT)))
 EXPR)

{;; General Utility Functions:⎇

(DEFPROP ADDTOLIST
 (LAMBDA (X Y) (COND [(MEMBER X Y) Y] [T (CONS X Y)]))
 EXPR)

(DEFPROP ASSOCR
 (LAMBDA (X Y)
  (PROG NIL
   LOOP (COND [(NULL Y) (RETURN NIL)] [(EQ X (CDAR Y)) (RETURN (CAR Y))])
	(SETQ Y (CDR Y))
	(GO LOOP)))
 EXPR)

(DEFPROP CONSTANTP
 (LAMBDA (XPR) (OR [NUMBERP XPR] [STRINGP XPR] [MEMB XPR '(T NIL)]))
 EXPR)

(DEFPROP DELETEPROP
 (LAMBDA (IDENT PROPNAM)
  (PROG (TEM)
	(SETQ TEM IDENT)
   LOOP (COND [(NULL (CDR TEM)) (RETURN NIL)])
	(COND [(EQ (CADR TEM) PROPNAM) (RPLACD TEM (CDDDR TEM)) (RETURN T)])
	(SETQ TEM (CDDR TEM))
	(GO LOOP)))
 EXPR)

(DEFPROP DEINITSYM (LAMBDA (NAME) (DELETEPROP NAME 'SYMNO)) EXPR)

(DEFPROP FSUBRP (LAMBDA (FUN) (GETL FUN '(FEXPR *FSUBR FSUBR))) EXPR)

(DEFPROP GETGET
 (LAMBDA (ATOM PROP)
  (PROG (TEM PTAB)
	(SETQ PTAB (FIRSTPROP ATOM))
   LOOP (COND [(LASTPROP PTAB) (RETURN NIL)])
	(COND [(SETQ TEM (SEEKPROP (PROPNAM PTAB) PROP)) (RETURN TEM)])
	(SETQ PTAB (NEXTPROP PTAB))
	(GO LOOP)))
 EXPR)

(DEFPROP HASPROP (LAMBDA (IDENT PROP) (GETL IDENT (LIST PROP))) EXPR)

(DEFPROP INITPROP
 (LAMBDA (IDENT PROPNAM PROPVAL)
  (RPLACD IDENT (MCONS PROPNAM PROPVAL (CDR IDENT))))
 EXPR)

(DEFPROP INITSYM (LAMBDA (NAME) (INITPROP NAME 'SYMNO 1Q)) EXPR)

(DEFPROP LSUBRP (LAMBDA (FUN) (GETL FUN '(LSUBR *LSUBR))) EXPR)

(DEFPROP MAKESPECIAL
 (LAMBDA (VAR)
  (PROG NIL
	(COND [(HASPROP VAR 'LOCAL)
	       (SETQ SPECIALS (ADDTOLIST VAR SPECIALS))
	       (PRINTMSG (CONS VAR '(LOCAL AND SPECIAL)))])
	(SETPROP VAR 'SPECIAL T)
	(RETURN VAR)))
 EXPR)

(DEFPROP MAKESYM
 (LAMBDA (IDENT NUMBER)
  (PROG (*NOPOINT)
	(SETQ *NOPOINT T)
	(RETURN (MAKNAM (NCONC (EXPLODE IDENT) (EXPLODE NUMBER))))))
 EXPR)

(DEFPROP MAKEUNSPECIAL
 (LAMBDA (VAR) (COND [(REMPROP VAR 'SPECIAL) VAR]))
 EXPR)

(DEFPROP NEXTSYM
 (LAMBDA (NAME)
  (PROG (NUM)
	(SETQ NUM (GETPROP NAME 'SYMNO))
	(PUTPROP NAME (ADD1 NUM) 'SYMNO)
	(RETURN (MAKESYM NAME NUM))))
 EXPR)

(DEFPROP NTHCDR
 (LAMBDA (NUM EXP)
  (PROG NIL
	(COND [(MINUSP NUM) (COMPERR NEGNUM-NTHCDR)])
   LOOP (COND [(ZEROP NUM) (RETURN EXP)])
	(COND [(ATOM EXP) (COMPERR ATOM-NTHCDR)])
	(SETQ EXP (CDR EXP))
	(SETQ NUM (SUB1 NUM))
	(GO LOOP)))
 EXPR)

(DEFPROP SEEKPROP
 (LAMBDA (IDENT PROPNAM)
  (PROG (TEM)
	(SETQ TEM (GETL IDENT (LIST PROPNAM)))
	(COND [(NULL TEM) (RETURN NIL)])
	(RETURN TEM)))
 EXPR)

(DEFPROP SUBRP
 (LAMBDA (FUN) (GETL FUN '(EXPR SUBR ARRAY *SUBR *UNDEF)))
 EXPR)

(DEFPROP TOPCOPY (LAMBDA (SXP) (APPEND SXP NIL)) EXPR)

{;; UCI Additions <with Rutgers modifications>:⎇

(DEFPROP NOCALL
 (LAMBDA (XPR) (EVALFLUSH (LIST 'DEFLIST XPR T 'NOCALL)))
 FEXPR)

(DEFPROP EVALFLUSH (LAMBDA (XPR) (EVAL XPR) (FLUSHEXPR XPR)) EXPR)

(DEFPROP CADDRLAM
 (LAMBDA (EXP)
  (COND [(CDDDR EXP) (CONS 'PROGN (CDDR EXP))] [T (CADDR EXP)]))
 EXPR)

(DEFPROP NEEDS
 (LAMBDA (AD)
  (AND [CONSP AD]
       [CADR AD]
       [MEMQ (CAR AD) '(QUOTE E SPECIAL)]
       [NOT (*GREAT (MAKNUM (CADR AD) 'FIXNUM) 377777Q)]))
 EXPR)

(DEFPROP P1PROGN (LAMBDA (XPR) (CONS 'PROGN (MAPP1 (CDR XPR)))) EXPR)

(DEFPROP PROGN P1PROGN P1)

(DEFPROP P2PROGN
 (LAMBDA (XPR VALAC EFFECTS)
  (PROG (ARGS)
	(COND [(NULL (SETQ ARGS (CDR XPR))) (USERERR NOARGS-P2PROGN)])
   LOOP (COND [(NULL (CDR ARGS)) (RETURN (COMPEXPR (CAR ARGS) VALAC EFFECTS))])
	(COMPE (CAR ARGS))
	(SETQ ARGS (CDR ARGS))
	(GO LOOP)))
 EXPR)

(DEFPROP PROGN P2PROGN P2)

(DEFPROP NEQ (LAMBDA (L) (LIST 'NOT (CONS 'EQ (CDR L)))) INMACRO)

(DEFPROP AND
 (LAMBDA (L)
  (COND [(CDR L)
	 (COND [(CDDR L) (LIST 'COND (LIST (CADR L) (CONS 'AND (CDDR L))))]
	       [T (CADR L)])]
	[T]))
 INMACRO)

(DEFPROP OR
 (LAMBDA (L)
  (COND [(CDR L) (CONS 'COND (MAPCAR (FUNCTION NCONS) (CDR L)))]))
 INMACRO)

(DEFPROP PROG1
 (LAMBDA (L)
  (COND [(LESSP (LENGTH (CDR L)) 5Q) (MCONS 'PROG2 0Q (CDR L))]
	[T (LIST 'PROG2 0Q (CADR L) (CONS 'PROG2 (CDDR L)))]))
 INMACRO)

(DEFPROP SELECTQ
 (LAMBDA (L)
  (PROG (FIRSTCL RESTCL RSLT)
	(SETQ RSLT (NCONS 'COND))
	(COND [(ATOM (CAR (SETQ L (CDR L)))) (SETQ FIRSTCL (SETQ RESTCL (CAR L)))]
	      [(EQ (CAAR L) 'SETQ) (SETQ FIRSTCL (CAR L)) (SETQ RESTCL (CADAR L))]
	      [T (SETQ FIRSTCL (LIST 'SETQ (SETQ RESTCL 'SELECTQ) (CAR L)))])
     LP (COND [(CDR (SETQ L (CDR L)))
	       (NCONC RSLT 
		      (NCONS (CONS (LIST (COND [(ATOM (CAAR L)) 'EQ] [T 'MEMQ])
					 FIRSTCL 
					 (LIST 'QUOTE (CAAR L)))
				   (CDAR L))))
	       (SETQ FIRSTCL RESTCL)
	       (GO LP)])
	(NCONC RSLT (NCONS (CONS T L)))
	(RETURN RSLT)))
 INMACRO)

(DEFLIST (SELECTQ) T SPECIAL)

(DEFPROP P1MAPC
 (LAMBDA (XPR)
  (ALLMAP XPR 
	  '(PROG NIL L1 (COND [(AND ALLARGS) (FN DOCARALLARGS) (GO L1)]))))
 EXPR)

(DEFPROP P1MAP
 (LAMBDA (XPR)
  (ALLMAP XPR 
	  '(PROG NIL L1 (COND [(AND ALLARGS) (FN DOALLARGS) (GO L1)]))))
 EXPR)

(DEFPROP P1MAPCAR
 (LAMBDA (XPR)
  (ALLMAP XPR 
	  (SUBPAIR '(TM1)
		   (LIST (GENVAR))
		   '(PROG (TM1)
			  (SETQ TM1 (NCONS NIL))
		       L1 (COND [(AND ALLARGS) (TCONC TM1 (FN DOCARALLARGS)) (GO L1)])
			  (RETURN (CAR TM1))))))
 EXPR)

(DEFPROP P1MAPLIST
 (LAMBDA (XPR)
  (ALLMAP XPR 
	  (SUBPAIR '(TM1)
		   (LIST (GENVAR))
		   '(PROG (TM1)
			  (SETQ TM1 (NCONS NIL))
		       L1 (COND [(AND ALLARGS) (TCONC TM1 (FN DOALLARGS)) (GO L1)])
			  (RETURN (CAR TM1))))))
 EXPR)

(DEFPROP P1MAPCONC
 (LAMBDA (XPR)
  (ALLMAP XPR 
	  (SUBPAIR '(TM1)
		   (LIST (GENVAR))
		   '(PROG (TM1)
			  (SETQ TM1 (NCONS NIL))
		       L1 (COND [(AND ALLARGS) (LCONC TM1 (FN DOCARALLARGS)) (GO L1)])
			  (RETURN (CAR TM1))))))
 EXPR)

(DEFPROP P1MAPCON
 (LAMBDA (XPR)
  (ALLMAP XPR 
	  (SUBPAIR '(TM1)
		   (LIST (GENVAR))
		   '(PROG (TM1)
			  (SETQ TM1 (NCONS NIL))
		       L1 (COND [(AND ALLARGS) (LCONC TM1 (FN DOALLARGS)) (GO L1)])
			  (RETURN (CAR TM1))))))
 EXPR)

(DEFLIST ((MAPC P1MAPC)
	  (MAP P1MAP)
	  (MAPCAR P1MAPCAR)
	  (MAPLIST P1MAPLIST)
	  (MAPCONC P1MAPCONC)
	  (MAPCAN P1MAPCONC)
	  (MAPCON P1MAPCON)
	  (MAPL P1MAPLIST)
	  (MAPCL P1MAPCAR))
	 P1)

(DEFPROP ALLMAP
 (LAMBDA (XPR FORM)
  (PROG (FN TMPS)
	(SETQ FN (CADR XPR))
    TRY (COND [(OR [ATOM FN] [NOT (MEMQ (CAR FN) ''FUNCTION)] [ATOM (CADR FN)])
	       (COND [(AND [CONSP FN] [LITATOM (CAR FN)] [SETQ TMPS (GET (CAR FN) 'MACRO)])
		      (SETQ FN (TMPS FN))
		      (GO TRY)]
		     [T (RETURN (CONS (CAR XPR) (P1SUBRARGS (CONS FN (CDDR XPR)))))])]
	      [T (SETQ TMPS (MAPCAR (FUNCTION (LAMBDA (X) (GENVAR))) (CDDR XPR)))
		 (RETURN (P1 (CONS (LIST 'LAMBDA
					 TMPS 
					 (FORMSUBST (CADR FN)
						    TMPS 
						    (MAPCAR
						     (FUNCTION
						      (LAMBDA (X)
						       (LIST 'PROG1 X (LIST 'SETQ X (LIST 'CDR X))))
						      )
						     TMPS)
						    (MAPCAR
						     (FUNCTION
						      (LAMBDA (X)
						       (LIST 'PROG1
							     (LIST 'CAR X)
							     (LIST 'SETQ X (LIST 'CDR X)))))
						     TMPS)
						    FORM))
				   (CDDR XPR))))])))
 EXPR)

(DEFPROP FORMSUBST
 (LAMBDA (FN ALLARGS DOALLARGS DOCARALLARGS FORM)
  (COND [(ATOM FORM) FORM]
	[(ATOM (CAR FORM))
	 (NCONC (SELECTQ [CAR FORM]
			 [FN (NCONS FN)]
			 [ALLARGS (COPY ALLARGS)]
			 [DOALLARGS (COPY DOALLARGS)]
			 [DOCARALLARGS (COPY DOCARALLARGS)]
			 [NCONS (CAR FORM)])
		(FORMSUBST FN ALLARGS DOALLARGS DOCARALLARGS (CDR FORM)))]
	[T (CONS (FORMSUBST FN ALLARGS DOALLARGS DOCARALLARGS (CAR FORM))
		 (FORMSUBST FN ALLARGS DOALLARGS DOCARALLARGS (CDR FORM)))]))
 EXPR)

(DEFPROP P2MAPC
 (LAMBDA (XPR VALAC EFFECTS)
  (COND [(EQ (LENGTH (CDR XPR)) 2Q)
	 (RPLACA XPR '*MAPC)
	 (PROG1 (CALLSUBR XPR VALAC EFFECTS) (RPLACA LASTOUT '(PUSHJ P *MAPC)))]
	[T (CALLLSUBR XPR VALAC EFFECTS)]))
 EXPR)

(DEFPROP P2MAP
 (LAMBDA (XPR VALAC EFFECTS)
  (COND [(EQ (LENGTH (CDR XPR)) 2Q)
	 (RPLACA XPR '*MAP)
	 (PROG1 (CALLSUBR XPR VALAC EFFECTS) (RPLACA LASTOUT '(PUSHJ P *MAP)))]
	[T (CALLLSUBR XPR VALAC EFFECTS)]))
 EXPR)

(DEFLIST ((MAPC P2MAPC) (MAP P2MAP)) P2)

{;; Rutgers Additions:⎇

(DEFPROP ; (LAMBDA (L) NIL) INMACRO)

(DEFPROP ;; (LAMBDA (L) NIL) INMACRO)

(DEFPROP CATCH
 (LAMBDA (L)
  (SETQ L (CDR L))
  (COND [(NULL (CDR L)) (LIST 'PROGN (LIST '%CATCH (CONS 'ERRSET L)) 'THROW)]
	[(ATOM (CADR L))
	 (LIST 'COND
	       (LIST (LIST 'OR
			   (LIST '%CATCH (LIST 'ERRSET (CAR L)))
			   (LIST 'EQ 'CATCH (CONS 'QUOTE (CDR L))))
		     'THROW)
	       '(T (ERR 'THROW)))]
	[T (LIST 'COND
		 (LIST (LIST '%CATCH (LIST 'ERRSET (CAR L))) 'THROW)
		 (LIST T 
		       (CONS 'SELECTQ (CONS 'CATCH (APPEND (CDR L) '((ERR 'THROW)))))))]))
 INMACRO)

(DEFPROP THROW
 (LAMBDA (L)
  (LIST 'PROGN
	(LIST 'SETQ 'THROW (CADR L))
	(LIST 'SETQ 'CATCH (AND [CDDR L] [LIST 'QUOTE (CADDR L)]))
	'(ERR 'THROW)))
 INMACRO)

(DEFLIST (CATCH THROW) T SPECIAL)

(DEFPROP NCONC
 (LAMBDA (L)
  (COND [(NULL (CDR L)) NIL]
	[(NULL (CDDR L)) (CADR L)]
	[T (LIST '*NCONC (CADR L) (CONS (CAR L) (CDDR L)))]))
 INMACRO)

(DEFPROP MSG
 (LAMBDA (L)
  (NCONC (CONS 'PROGN
	       (MAPCAR (FUNCTION
			(LAMBDA (X)
			 (COND [(EQ X T) '(TERPRI)]
			       [(NUMBERP X)
				(COND [(*LESS X 1Q) (LIST 'LINES (MINUS X))] [T (LIST 'SPACES X)])]
			       [(STRINGP X) (LIST 'PRINAC (LIST 'QUOTE X))]
			       [(AND [CONSP X] [EQ (CAR X) 'E]) (CADR X)]
			       [(AND [CONSP X] [EQ (CAR X) 'T]) (LIST 'TAB (CADR X))]
			       [T (LIST 'PRINA X)])))
		       (CDR L)))
	 '(NIL)))
 INMACRO)

(DEFPROP TTYMSG
 (LAMBDA (L)
  (LIST 'OUTC
	(LIST 'PROG1 '(OUTC NIL NIL) '(TALK) (CONS 'MSG (CDR L)))
	NIL))
 INMACRO)

(DEFPROP TTYIN
 (LAMBDA (L)
  (LSUBST (CDR L)
	  'EXPRS
	  (SUBPAIR '(TM1 INOUTC)
		   (LIST (GENVAR) (COND [(EQ (CAR L) 'TTYIN) 'INC] [T 'OUTC]))
		   '(PROG (TM1)
			  (SETQ TM1 (INOUTC NIL NIL))
			  (RETURN (PROG1 (PROGN EXPRS) (INOUTC TM1 NIL)))))))
 INMACRO)

(DEFP TTYOUT TTYIN INMACRO)

(DEFPROP MAPATOMS
 (LAMBDA (L)
  (SUBPAIR '(FN TM1)
	   (LIST (CADR L) (GENVAR))
	   '(MAPC (FUNCTION (LAMBDA (TM1) (MAPC FN TM1))) OBLIST)))
 INMACRO)

(DEFLIST (OBLIST) T SPECIAL)

(DEFPROP P1SUBSET
 (LAMBDA (XPR)
  (COND [(NEQ (LENGTH (CDR XPR)) 2Q) (USERERR ARGNO-P1SUBSET)])
  (ALLMAP XPR 
	  (SUBPAIR '(TM1 TM2)
		   (LIST (GENVAR) (GENVAR))
		   '(PROG (TM1 TM2)
			  (SETQ TM1 (NCONS NIL))
		       L1 (COND [(NULL ALLARGS) (RETURN (CAR TM1))]
				[(FN (SETQ TM2 DOCARALLARGS)) (TCONC TM1 TM2)])
			  (GO L1)))))
 EXPR)

(DEFPROP P1EVERY
 (LAMBDA (XPR)
  (ALLMAP XPR 
	  '(PROG NIL
	      L1 (COND [(NULL (AND ALLARGS)) (RETURN T)] [(FN DOCARALLARGS) (GO L1)]))))
 EXPR)

(DEFPROP P1SOME
 (LAMBDA (XPR)
  (ALLMAP XPR 
	  (SUBPAIR '(TM1)
		   (LIST (GENSYM))
		   '(PROG (TM1)
		       L1 (COND [(NULL (SETQ TM1 (AND ALLARGS))) (RETURN NIL)]
				[(FN DOCARALLARGS) (RETURN TM1)]
				[T (GO L1)])))))
 EXPR)

(DEFPROP P1APPLY
 (LAMBDA (XPR)
  (PROG (CDRXPR)
	(SETQ CDRXPR (P1SUBRARGS (CDR XPR)))
	(RETURN (CONS (COND [(CDDR CDRXPR) 'APPLY] [T '*APPLY]) CDRXPR))))
 EXPR)

(DEFPROP P1ERRSET
 (LAMBDA (XPR)
  (PROG (INPROG)
	(RETURN (CONS 'ERRSET (CONS (P1 (CADR XPR)) (CDDR XPR))))))
 EXPR)

(DEFLIST ((SUBSET P1SUBSET) (EVERY P1EVERY) (SOME P1SOME) (APPLY P1APPLY) (ERRSET P1ERRSET))
	 P1)

(DEFPROP P2APPLY#
 (LAMBDA (XPR VALAC EFFECTS)
  (PROG (TEM)
	(COND [(AND [EQ (CAADR XPR) 'QUOTE]
		    [GETL (SETQ TEM (CADADR XPR)) '(FEXPR FSUBR *FSUBR)])
	       (GO FAST)]
	      [T (RETURN (CALLSUBR XPR VALAC EFFECTS))])
   FAST (LOADCOMP (CADDR XPR) FARGAC)
	(CLEAR2BOTH)
	(PROTECTACS TEM)
	(OUTCALL 17Q TEM)
	(RETURN (MARKVAL VALUEAC EFFECTS))))
 EXPR)

(DEFPROP P2ERRSET
 (LAMBDA (XPR VALAC EFFECTS)
  (PROG (HOME INST RETTAG VAL)
	(CLEAR1)
	(SLOTPUSH '(NIL . TAKEN))
	(OUTPUSH (GENCONST 0Q 0Q (SETQ RETTAG (GENTAG)) 0Q))
	(LOADARG VALUEAC (CONS 'QUOTE (OR [CDDR XPR] '[T])))
	(SLOTPUSH '(NIL . TAKEN))
	(SLOTPUSH '(NIL . TAKEN))
	(SLOTPUSH '(NIL . TAKEN))
	(SLOTPUSH '(NIL . TAKEN))
	(SLOTPUSH '(NIL . TAKEN))
	(OUTINST '(JSP 13Q *ERRSET1))
	(SETQ HOME (TOPCOPY PDL))
	(LOADARG VALUEAC (SETQ INST (COMP (CADR XPR) VALUEAC)))
	(RESTOR HOME)
	(REMOVL INST)
	(PROGN (SLOTPOP) (SLOTPOP) (SLOTPOP) (SLOTPOP) (SLOTPOP) (SLOTPOP))
	(CLEAR2BOTH)
	(CLEARACS)
	(SETQ VAL (MARKVAL VALUEAC EFFECTS))
	(OUTINST '(JRST 0Q *ERRSET2))
	(OUTTAG RETTAG)
	(RETURN VAL)))
 EXPR)

(DEFLIST ((APPLY# P2APPLY#) (ERRSET P2ERRSET)) P2)

(DEFPROP IGNORE (LAMBDA (L) NIL) EXPR)

(DEFPROP CALL (LAMBDA (L) (FLUSHEXPR (LIST 'DEFLIST L T 'CALL))) FEXPR)

(DEFPROP *SUBR (LAMBDA (L) (APPLY# 'DEFLIST (LIST L T '*SUBR))) FEXPR)

(DEFPROP *FSUBR (LAMBDA (L) (APPLY# 'DEFLIST (LIST L T '*FSUBR))) FEXPR)

(DEFPROP *LSUBR (LAMBDA (L) (APPLY# 'DEFLIST (LIST L T '*LSUBR))) FEXPR)

(DEFPROP GLOBALMACRO
 (LAMBDA (L) (APPLY# 'DEFLIST (LIST L T 'GLOBALMACRO)))
 FEXPR)

(DEFP *EXPR *SUBR (FEXPR FSUBR))

(DEFP *ARRAY *SUBR (FEXPR FSUBR))

(DEFP *FEXPR *FSUBR (FEXPR FSUBR))

(DEFP *LEXPR *LSUBR (FEXPR FSUBR))

(DEFLIST ((EXIT 1Q)
	  (SPRINT 2Q)
	  (PRINA 2Q)
	  (PRINAC 2Q)
	  (LINEREAD 1Q)
	  (READL 1Q)
	  (INSERT 4Q)
	  (MERGE 4Q)
	  (SORT 3Q)
	  (ERR 1Q)
	  (ERROR 1Q)
	  (DIR 1Q)
	  (SPACES 2Q)
	  (PRINL 2Q)
	  (PRINLC 2Q)
	  (TYOA 2Q))
	 *SUBR)

(NOCOMPILE
(DEFV LISPCFNS ((;; This is the RUCI LISP compiler; It was originally copied from Stanford but 
		has since been extensively modified; Entirely new code from UCI and Rutgers is at 
		the end of the file;) (DECLARE (SPECIAL *NOPOINT *NOPOINTDSK ACS ALLACS ALLFUNS 
		ARRAYAC BASE CATCH CCLST CODESIZE CONSTSIZE CTAG CURLOCVS DEBUGXPR EXIT EXITN 
		FARGAC FOUNDFREE FUNNAME GENFUNS GOLIST GOTABAC IBASE INDEV INLSUBR INPROG INUM0 
		LAPKLST LAPLST LASTOUT LDLST LISTING LOCVARS MINDEPTH MSGCHAN NACS OBLIST OUTDEV 
		OUTEXT P1CNT P1SCNT P2CNT PDL PDLDEPTH PRGSPFLG PROGSW PROGVARS PRSSL PVR 
		RENAMELIST RSL SELECTQ SHOWNAMES SPECIALS SPECVARS SPLDLST THROW TRACELIST 
		UNDFUNS VALUEAC VARLIST VGO) (*FSUBR COMPERR USERERR)) (*PG*) (;; Compiler 
		Macros:) (F: FIRSTPROP FLUSHDEF GENTAG GENVAL GENVAR GETPROP INCR LASTPROP 
		NEXTPROP OUTINST OUTPSOP OUTTAG PDLDEPTH PROPNAM PROPVAL SETPROP TAGP USERWARN) 
		(*PG*) (;; Top Level:) (F: ACTONEXPR ACTONMACRO CMP COMPDEF COMPFILE COMPFUNC 
		COMPILE COMPILEFUN COMPL COMPREADS CURFUN DECLARE DEFEXPR DEFFEXPR DEFMACRO 
		DO*EXPR DO*FEXPR DO*LEXPR DOACT DODE DODF DODM DOFILE FLUSHEXPR FLUSHLAP 
		FUNVARTST MAKDEF PRINTMSG READLOOP SPECIAL TELLTALE TYPEFN UNSPECIAL) (DEFLIST 
		((COMPACTION DOACT) (MACRO ACTONMACRO)) COMPEFFECT) (DEFLIST ((DE DODE) 
		(DF DODF) (DM DODM) (DECLARE EVAL) (DEFPROP COMPDEF) (LAP FLUSHLAP) (SPECIAL EVAL) 
		(UNSPECIAL EVAL) (*SUBR EVAL) (*ARRAY EVAL) (*FSUBR EVAL) (*LSUBR EVAL) 
		(*EXPR EVAL) (*FEXPR EVAL) (*LEXPR EVAL) (NOCALL EVAL) (CALL EVAL) (NOCOMPILE 
		IGNORE) (GLOBALMACRO EVAL)) COMPACTION) (P: (COMPACTION) ; ;;) (DEFLIST 
		((EXPR DEFEXPR) (FEXPR DEFFEXPR) (MACRO DEFMACRO) (SPECIAL EVAL) (DEFACTION EVAL) 
		(*EXPR DO*EXPR) (*FEXPR DO*FEXPR) (*LEXPR DO*LEXPR) (*SUBR EVAL) (*FSUBR EVAL) 
		(*LSUBR EVAL) (NOCALL EVALFLUSH) (CALL FLUSHEXPR)) DEFACTION) (V: MSGCHAN LISTING 
		INDEV OUTDEV OUTEXT SHOWNAMES) (*PG*) (;; **** PASS1 ****) (F: DOP1 GENFUN MAPP1 
		NEWNAME PASS1 PASS1FSUBR PASS1FUNVAR PASS1LSUBR PASS1MACRO PASS1SUBR PASS1UNDEF 
		P1 P1BIND P1BUG P1COND P1CONS P1ELSE P1EVAL P1FUNCTION P1GO P1LABEL P1LAM P1PROG 
		P1RETURN P1SETQ P1STORE P1SUBRARGS PUTLOC RENAM SPECIALP VARB VARIABLEP) 
		(DEFLIST ((EXPR PASS1SUBR) (*EXPR PASS1SUBR) (SUBR PASS1SUBR) (*SUBR PASS1SUBR) 
		(*UNDEF PASS1UNDEF) (*LEXPR PASS1LSUBR) (LSUBR PASS1LSUBR) (*LSUBR PASS1LSUBR) 
		(FEXPR PASS1FSUBR) (*FEXPR PASS1FSUBR) (FSUBR PASS1FSUBR) (*FSUBR PASS1FSUBR) 
		(P1 DOP1) (FUNVAR PASS1FUNVAR) (MACRO PASS1MACRO)) PASS1) (DEFLIST ((COND P1COND) 
		(GO P1GO) (PROG P1PROG) (EVAL P1EVAL) (SETQ P1SETQ) (STORE P1STORE) (CONS P1CONS) 
		(*FUNCTION P1FUNCTION) (FUNCTION P1FUNCTION) (RETURN P1RETURN)) P1) (V: 
		(SPECIALS NIL) PDL ACS LDLST SPLDLST CCLST) (*PG*) (;; Internal macros:) 
		(P: (PASS1) INMACRO) PASS1INMACRO (P: (DEFACTION) INMACRO) (P: (INMACRO) APPEND 
		LIST NOT =0) (*PG*) (;; **** PASS2 ****) (F: ACEFFECTS ACNUMP BINDVARS BOOLCOND 
		BOOLEQ BOOLEQ1 BOOLEXPR BOOLNULL BOOLQUOTE BOOLVALUE CALLFSUBR CALLFUNARGS 
		CALLLSUBR CALLSUBR CLEAR1 CLEAR1BOTH CLEAR2BOTH CLEARAC CLEARITALL CLEARACS 
		CLRCCLST CLRCCLST1 CLRCCLST2 CLRPVARS CLRSPLD CLRSPVAR COMP COMPARGS COMPE 
		COMPEXPR COPT CPUSH CSFUN CSTEP DOP2 DVP EQUIVTAG EXITBUM FREEAC FREEAC1 
		FINDFREEAC FREEZE FREEZE1 GENCONST GETSLOT ILOC ILOC1 INITZ INTERNALLAMBDA 
		KILLPDL LAMBDABIND LISTNILS LOADARG LOADCARCDR LOADCOMP LOADSUBRARGS LOC MARKVAL 
		NONSPECVARS OUT1 OUTCALL OUTCALLF OUTCJMP OUTENDTAG OUTFUNCALL OUTGOTAB OUTJCALL 
		OUTJMP OUTJRST OUTMOVE OUTMOVEM OUTPOP OUTPUSH OUTPUTSTAT OUTSTAT PASS2 P2*EVAL 
		P2ARG P2CARCDR P2COND P2COND1 P2ELSE P2EQ P2GO P2NULL P2PROG P2PROG1 P2PROG2 
		P2QUOTE P2RETURN P2RPLAC P2SETARG P2SETQ P2STORE PROGBIND PROGTAG PROTECTACS 
		PUTINAC REMOVL REMLST REMOVS REMSPVAR RESTOR RSLSET RST SAVEACS SETSLOT SHRINKPDL 
		SIDEEFFECTS SLOTCONT SLOTLIST SLOTPOP SLOTPUSH SPECVARP TRANSOUT USEDTAGP) 
		(DEFLIST ((EXPR CALLSUBR) (SUBR CALLSUBR) (*SUBR CALLSUBR) (*UNDEF CALLSUBR) 
		(LSUBR CALLLSUBR) (*LSUBR CALLLSUBR) (FEXPR CALLFSUBR) (FSUBR CALLFSUBR) 
		(*FSUBR CALLFSUBR) (FUNVAR CALLFUNARGS) (CARCDR P2CARCDR) (P2 DOP2)) PASS2) 
		(DEFLIST ((ARG P2ARG) (*EVAL P2*EVAL) (COND P2COND) (EQ P2EQ) (GO P2GO) 
		(NULL P2NULL) (QUOTE P2QUOTE) (PROG P2PROG) (PROG2 P2PROG2) (RETURN P2RETURN) 
		(RPLACA P2RPLAC) (RPLACD P2RPLAC) (SETARG P2SETARG) (SETQ P2SETQ) (STORE P2STORE)) 
		P2) (DEFLIST ((EQ BOOLEQ) (NULL BOOLNULL) (QUOTE BOOLQUOTE) (COND BOOLCOND)) BOOL) 
		(DEFLIST ((ASSOC 3Q) (ATOM 1Q) (CHRCT 1Q) (CHRPOS 1Q) (CLRBFI 1Q) (CONS 3Q) 
		(CONSP 3Q) (FREE 1Q) (FREELIST 3Q) (GENSYM 7Q) (GET 1Q) (LAST 3Q) (LENGTH 7Q) 
		(LITATOM 3Q) (MEMB 7Q) (MEMQ 7Q) (NCONS 3Q) (NUMBERP 3Q) (*NCONC 7Q) (PATOM 1Q) 
		(PROMPT 1Q) (READP 1Q) (REVERSE 3Q) (REMPROP 3Q) (STRINGP 3Q) (TALK 1Q) 
		(UNTYI 3Q) (XCONS 3Q)) ACS) (DEFLIST ((CONS XCONS) (EQUAL EQUAL) (*GREAT *LESS) 
		(*LESS *GREAT) (*PLUS *PLUS) (*TIMES *TIMES) (*MIN *MIN) (*MAX *MAX) (+ +) 
		(* *) (= =) (LT GT) (GT LT) (LE GE) (GE LE)) COMMU) (DEFLIST ((CAME CAIE) 
		(CAMN CAIN) (HLLZS@ HLLZS) (HLRZ@ HLRZ) (HRLM@ HRLM) (HRRM@ HRRM) (HRRZ@ HRRZ) 
		(HRRZS@ HRRZS) (MOVE MOVEI)) IMMED) (V: CARCDRDEPTH) (MBD: PROGN SETUPCARCDRS) 
		(SETUPCARCDRS) (V: NACS VALUEAC FARGAC GOTABAC ARRAYAC) (SETQ INUM0 (MAKNUM 0Q 
		(QUOTE FIXNUM))) (*PG*) (;; Debugging Functions:) (F: CMPBREAK COMPERR LAPNOTES 
		USERERR) (V: (TRACELIST NIL)) (*PG*) (;; IO Functions:) (F: ATMARGIN CARRETN 
		LINEF MAPPRINS PRINS PRINTEXPR PRINTSTAT) (*PG*) (;; General Utility Functions:) 
		(F: ADDTOLIST ASSOCR CONSTANTP DELETEPROP DEINITSYM FSUBRP GETGET HASPROP 
		INITPROP INITSYM LSUBRP MAKESPECIAL MAKESYM MAKEUNSPECIAL NEXTSYM NTHCDR SEEKPROP 
		SUBRP TOPCOPY) (*PG*) (;; UCI Additions <with Rutgers modifications>:) 
		(F: NOCALL EVALFLUSH CADDRLAM NEEDS P1PROGN (P: (P1) PROGN) P2PROGN (P: 
		(P2) PROGN)) (P: (INMACRO) NEQ AND OR PROG1 SELECTQ (DEFLIST (SELECTQ) T SPECIAL)) 
		(F: P1MAPC P1MAP P1MAPCAR P1MAPLIST P1MAPCONC P1MAPCON) (DEFLIST ((MAPC P1MAPC) 
		(MAP P1MAP) (MAPCAR P1MAPCAR) (MAPLIST P1MAPLIST) (MAPCONC P1MAPCONC) (MAPCAN 
		P1MAPCONC) (MAPCON P1MAPCON) (MAPL P1MAPLIST) (MAPCL P1MAPCAR)) P1) (F: ALLMAP 
		FORMSUBST P2MAPC P2MAP) (DEFLIST ((MAPC P2MAPC) (MAP P2MAP)) P2) (*PG*) 
		(;; Rutgers Additions:) (P: (INMACRO) ; ;; CATCH THROW (DEFLIST (CATCH THROW) T 
		SPECIAL) NCONC MSG TTYMSG TTYIN (DEFP TTYOUT TTYIN INMACRO) MAPATOMS (DEFLIST
		(OBLIST) T SPECIAL)) (F: P1SUBSET P1EVERY P1SOME P1APPLY P1ERRSET) 
		(DEFLIST ((SUBSET P1SUBSET) (EVERY P1EVERY) (SOME P1SOME) (APPLY P1APPLY) 
		(ERRSET P1ERRSET)) P1) (F: P2APPLY# P2ERRSET) (DEFLIST ((APPLY# P2APPLY#) 
		(ERRSET P2ERRSET)) P2) (F: IGNORE CALL *SUBR *FSUBR *LSUBR GLOBALMACRO) 
		(FORMS: (DEFP *EXPR *SUBR (FEXPR FSUBR)) (DEFP *ARRAY *SUBR (FEXPR FSUBR)) 
		(DEFP *FEXPR *FSUBR (FEXPR FSUBR)) (DEFP *LEXPR *LSUBR (FEXPR FSUBR))) 
		(DEFLIST ((EXIT 1Q) (SPRINT 2Q) (PRINA 2Q) (PRINAC 2Q) (LINEREAD 1Q) (READL 1Q) 
		(INSERT 4Q) (MERGE 4Q) (SORT 3Q) (ERR 1Q) (ERROR 1Q) (DIR 1Q) (SPACES 2Q) 
		(PRINL 2Q) (PRINLC 2Q) (TYOA 2Q)) *SUBR)))
)